PDA

View Full Version : Module to Delete rows by multiple column criteria



buclao
09-21-2011, 03:12 PM
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
09-21-2011, 07:31 PM
Hi.
While we await a more elegant solution if you want to try if this one could help ...


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

Bob Phillips
09-22-2011, 12:39 AM
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