Module to Delete rows by multiple column criteria

[buclao]

First of all, thank you for taking the time to read this and thank you for your support.

I have 2 columns, A and B. In column A I have defined an ID and on Column B I have defined a criteria on wether the row for the ID should be deleted or not. What Im trying to do is look up for duplicate values on the column A and then look up on the Column B to see if the row should be deleted or not. In case that there are duplicates for both columns I would like to highlight those cells in yellow and don't delete them at all. Any1 with an idea on where to begin or what type write first?

Thanks in advance!

[omp001]

Hi.
While we await a more elegant solution if you want to try if this one could help ...


[vba]Sub Check()
Dim LRa, LRb, i As Long
LRa = Range("A" & Rows.Count).End(xlUp).Row
LRb = Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To LRa
If Application.CountIf(Range("A2:A" & LRa), _
Range("A" & i).Value) > 1 And _
Range("A" & i).Value <> "" Then
If Application.CountIf(Range("B2:B" & LRb), _
Range("A" & i).Value) > 0 Then
Range("A" & i).Interior.ColorIndex = 36
End If
End If
Next i
For i = 1 To LRb
If Application.CountIf(Range("A2:A" & LRa), _
Range("B" & i).Value) > 1 And _
Range("B" & i).Value <> "" Then
Range("B" & i).Interior.ColorIndex = 36

End If
Next i
End Sub
[/vba]

[Bob Phillips]

[vba]

ublic Sub ProcessData()
Dim Lastrow As Long
Dim i As Long

Application.ScreenUpdating = False

With ActiveSheet

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = Lastrow To 2 Step -1

If Application.CountIf(.Columns("A"), .Cells(i, "A").Value) > 0 Then

If Application.CountIf(.Columns("B"), .Cells(i, "B").Value) = 1 Then

.Cells(i, "A").Resize(, 2).Interior.ColorIndex = 6
Else

.Rows(i).Delete
End If
End If
Next i
End With

Application.ScreenUpdating = True
End Sub[/vba]