Match data in 2 columns

[cbb007]

Hi All, this complete VBA newbie needs a little help. I use Excel 2007.

Here are the rules:
1) this process depends on the names in Col. A. There can be 1, 2 or 3 occurrances of a name in Col. A and they will always be sequential.
2) if there is one occurrance of a name in Col. A and it matches Col. B, put "***" in Col. C.
3) if there are two occurrances of a name in Col. A and one of them matches Col. B, put "***" in Col. C of the one that matches.
4) if there are three occurrances of a name in Col. A and one of them matches Col. B, delete the one that matches. If two of them match, delete only one of them.

The names that match can be any one of the 1, 2 or 3 occurrances.

The attached spreadsheet shows the results after the procedure is run. The two rows that say "This should be deleted" should actually be deleted.

Thank you.

[cbb007]

Well, after searching the internet and various forums I finally came up with a solution. It may not be very elegant or efficient, but it works the way I want it to. Hopefully it will help others out there in cyberland. My solution involves two subroutines, the first marks the records to be deleted, then after human review the second actually deletes the records. Here it is:

Option Explicit
Sub MarkTheDups()

Dim Row As Double
Dim ColC As Integer
Dim ColD As Integer
Dim ColE As Integer
ColC = 3
ColD = 4
ColE = 5
'
'SaveC saves the contents of col C to match against
Dim SaveC As String
'
'ColCContents saves the contents of col C to match against
Dim ColCContents As String
'ColDContents saves the contents of col D to match against
Dim ColDContents As String
'
'MatchCCount counts the number of occurrences in col C (1, 2 or 3)
Dim MatchCCount As Integer
'
'MatchRow is the row that has the match
Dim MatchRow As Double
'
'DelInd if it's turned on, delete the record
Dim DelInd As Integer
'
ColCContents = ""
ColDContents = ""
SaveC = ""
MatchCCount = 0
MatchRow = 0
DelInd = 0

Columns("E:E").Select
Selection.Insert Shift:=xlToRight

For Row = 1 To 1000
ColCContents = Cells(Row, ColC).Value
ColDContents = Cells(Row, ColD).Value
If ColCContents <> SaveC Then
If MatchCCount = 0 Then DelInd = 0
If MatchCCount = 1 Then DelInd = 0
If MatchCCount = 2 Then DelInd = 0
If MatchCCount = 3 Then DelInd = 1
If DelInd = 1 Then
Cells(MatchRow, ColE).Value = "Delete"
End If
MatchCCount = 0
MatchRow = 0
DelInd = 0
SaveC = ColCContents
End If

If ColCContents = SaveC Then
MatchCCount = MatchCCount + 1
End If
If ColCContents = ColDContents And SaveC <> "" Then
Cells(Row, ColE).Value = "***"
End If
If ColCContents = ColDContents And SaveC <> "" Then
MatchRow = Row
End If
Next

End Sub

Sub DeleteTheDups()
'============================================================================
' Delete all rows from the bottom UPWARDS with "***" or "Delete" in Column E
'============================================================================
Dim Row As Double
Dim Last As Double

'Find the last row that has data in Col C
Last = Cells(Rows.Count, "C").End(xlUp).Row

For Row = Last To 1 Step -1
If (Cells(Row, "E").Value) = "***" Then
Cells(Row, "A").EntireRow.Delete
End If
If (Cells(Row, "E").Value) = "Delete" Then
Cells(Row, "A").EntireRow.Delete
End If
Next Row

Columns("E:E").Select
Selection.Delete Shift:=xlToLeft

End Sub

[cbb007]

In my solution above, the columns in the final solution don't match the columns in my sample spreadsheet, but you get the idea....