Help Delete Rows based on the macro in this message

[Guest]

Hi

Could someone please help me with the following macro? The macro sorts two columns of data so that identical information lines up side by side. My problem is, I would like anything that matches in column A & B to be deleted only leaving the data where there is not another matching record in the column next to it.

I would also like any rows that have been deleted to shift up so I am only left with rows with data in them and no blank rows.

Please see the code below.

Sub Macro()
Dim myCell As Range
Dim row As Long, i As Long

Range("A:A").Sort Key1:=Range("A1"), order1:=xlAscending, header:=xlNo
Range("B:B").Sort Key1:=Range("B1"), order1:=xlAscending, header:=xlNo

row = 1
Do Until IsEmpty(Cells(row, "A")) And IsEmpty(Cells(row, "B"))

If Cells(row, 2).Value <> Cells(row, 1).Value And Cells(row, 1).Value < Cells(row, 2).Value Then
Cells(row, 2).Insert Shift:=xlDown
Else
If Cells(row, 1).Value <> Cells(row, 2).Value And Cells(row, 2).Value > Cells(row, 1).Value Then
Cells(row, 2).Insert Shift:=xlDown
End If
End If
row = row + 1
Loop
End Sub


Thanks in advance

Malcolm

 

[Jim Rech]

Your code and message is confusing because you talk about deleting rows and
your code inserts them. anyway this is how I might generally delete any
rows where the values in columns A and B are the same:

Sub a()
Dim Counter As Long
Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row
For Counter = LastRow To 1 Step -1
If Cells(Counter, 1).Value = Cells(Counter, 2).Value Then _
Rows(Counter).Delete xlUp
Next
End Sub

--
Jim Rech
Excel MVP
| Hi
|
| Could someone please help me with the following macro? The macro sorts
two columns of data so that identical information lines up side by side. My
problem is, I would like anything that matches in column A & B to be deleted
only leaving the data where there is not another matching record in the
column next to it.
|
| I would also like any rows that have been deleted to shift up so I am only
left with rows with data in them and no blank rows.
|
| Please see the code below.
|
| Sub Macro()
| Dim myCell As Range
| Dim row As Long, i As Long
|
| Range("A:A").Sort Key1:=Range("A1"), order1:=xlAscending, header:=xlNo
| Range("B:B").Sort Key1:=Range("B1"), order1:=xlAscending, header:=xlNo
|
| row = 1
| Do Until IsEmpty(Cells(row, "A")) And IsEmpty(Cells(row, "B"))
|
| If Cells(row, 2).Value <> Cells(row, 1).Value And Cells(row, 1).Value <
Cells(row, 2).Value Then
| Cells(row, 2).Insert Shift:=xlDown
| Else
| If Cells(row, 1).Value <> Cells(row, 2).Value And Cells(row, 2).Value >
Cells(row, 1).Value Then
| Cells(row, 2).Insert Shift:=xlDown
| End If
| End If
| row = row + 1
| Loop
| End Sub
|
|
| Thanks in advance
|
| Malcolm
|
|