Help Delete Rows based on the macro in this message
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
|