I am trying to compare two columns (A and B) for duplicates. As an output I am trying to get cells that does not match (not duplicates). Column A values are coming from table 1 and Column B values are coming from table 2. Code target is basically to get to know which items were deleted from table 2 (Column B).
Data looks like:
A B
BMW PORSCHE
FIAT VOLVO
VOLVO AUDI
PORSCHE FERRARI
FERRARI TOYOTA
TOYOTA
AUDI
Output should be:
A B
BMW
FIAT
This is working for highlighting duplicates, but how to get values deleted that are duplicates? For example using .ClearContents
. Then after that I have loop for deleting empty rows in range.
Sub MarkDuplicatesInCompare()
Dim ws As Worksheet
Dim cell As Range
Dim myrng As Range
Dim clr As Long
Dim lastCell As Range
Dim EntireRow As Range
Set ws = ThisWorkbook.Sheets("Compare")
Set myrng = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Rows.Count, "B").End(xlUp))
With myrng
Set lastCell = .Cells(.Cells.Count)
End With
myrng.Interior.ColorIndex = xlNone
clr = 3
For Each cell In myrng
If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
If myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Address = cell.Address Then
cell.Interior.ColorIndex = clr
clr = clr
Else
cell.Interior.ColorIndex = myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Interior.ColorIndex
End If
End If
Next
' Delete empty rows
For I = myrng.Rows.Count To 1 Step -1
Set EntireRow = myrng.Cells(I, 1).EntireRow
If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
EntireRow.Delete
End If
Next
End Sub