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

Help Delete Rows based on the macro in this message
 

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
"malycom" wrote in 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
|
|