compare columns

[dandana]

Hi,
i need to compare two columns for differences and highlight them; the columns may contain duplicate data.
As example, for the below two columns, DWB931 on column A and DWD966 from column B should be highlighted. Note that there is one DWD966 in column A but two in column B.
i need to do this in VBA.
Thanks

[TABLE="width: 164"]
<colgroup><col span="2"></colgroup><tbody>[TR]
[TD]DWB010[/TD]
[TD]DWB010[/TD]
[/TR]
[TR]
[TD]DWB251[/TD]
[TD]DWB251[/TD]
[/TR]
[TR]
[TD]DWB253[/TD]
[TD]DWB253[/TD]
[/TR]
[TR]
[TD]DWB931[/TD]
[TD]DWD860[/TD]
[/TR]
[TR]
[TD]DWD860[/TD]
[TD]DWD860[/TD]
[/TR]
[TR]
[TD]DWD860[/TD]
[TD]DWD861[/TD]
[/TR]
[TR]
[TD]DWD861[/TD]
[TD]DWD862[/TD]
[/TR]
[TR]
[TD]DWD862[/TD]
[TD]DWD911[/TD]
[/TR]
[TR]
[TD]DWD911[/TD]
[TD]DWD912[/TD]
[/TR]
[TR]
[TD]DWD912[/TD]
[TD]DWD913[/TD]
[/TR]
[TR]
[TD]DWD913[/TD]
[TD]DWD914[/TD]
[/TR]
[TR]
[TD]DWD914[/TD]
[TD]DWD915[/TD]
[/TR]
[TR]
[TD]DWD915[/TD]
[TD]DWD920[/TD]
[/TR]
[TR]
[TD]DWD920[/TD]
[TD]DWD922[/TD]
[/TR]
[TR]
[TD]DWD922[/TD]
[TD]DWD966[/TD]
[/TR]
[TR]
[TD]DWD966[/TD]
[TD]DWD966[/TD]
[/TR]
[TR]
[TD]DWD967[/TD]
[TD]DWD967[/TD]
[/TR]
[TR]
[TD]DWD968[/TD]
[TD]DWD968[/TD]
[/TR]
[TR]
[TD]EBO101[/TD]
[TD]EBO101[/TD]
[/TR]
</tbody>[/TABLE]

 

[JustynaMK]

Hi dandana,

I know you are looking for VBA solution, but maybe Conditional Formatting will do the trick?
If your sample data is in cells A1:B19, you can select cell A1 > Conditional Formatting > New Rule > Use a formula to determine which cells to format:
=COUNTIF($A$1:$A$19,A1) <> COUNTIF($B$1:$B$19,A1)
Set format to Red Font.
Go back to Conditional Formatting > Manage rules and change "Applies to" to =$A$1:$B$19

Note that it will also highlight all the remaining "DWD966" (cell A16 and B16) as the count of these items differs for both columns, thus making conditional formatting to apply.

I hope it helps. Let me know your thoughts.

 

[dandana]

Thanks, but i need a VBA solution and also i just need the differences highlighted.
This is what i use now, but this is just seeing the differences as in missings, not the duplicates (most of the VBA code is from internet, credit to who create it...)

Sub compare_new()'clear formats
Range("a1:f500").ClearFormats
'sort
Range("A1", Range("A1").End(xlDown)).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
Range("B1", Range("B1").End(xlDown)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo
'Get the last row
    Dim Report As Worksheet
    Dim i As Integer, j As Integer
    Dim lastrow As Integer


    Set Report = ActiveSheet 'Excel.Worksheets("Sheet4") 'You could also use Excel.ActiveSheet
                                            'if you always want this to run on the current sheet.


    lastrow = Report.UsedRange.Rows.Count


    Application.ScreenUpdating = False


    For i = 1 To lastrow
        For j = 1 To lastrow
            If Report.Cells(i, 1).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                If InStr(1, Report.Cells(j, 2).Value, Report.Cells(i, 1).Value, vbTextCompare) > 0 Then
                    'You may notice in the above instr statement, I have used vbTextCompare instead of its numerical value, _
                    I find this much more reliable.
                    Report.Cells(i, 1).Interior.Color = RGB(255, 255, 255) 'White background
                    Report.Cells(i, 1).Font.Color = RGB(0, 0, 0) 'Black font color
                    Exit For
                Else
                    Report.Cells(i, 1).Interior.Color = RGB(156, 0, 6) 'Dark red background
                    Report.Cells(i, 1).Font.Color = RGB(255, 199, 206) 'Light red font color
                End If
            End If
        Next j
    Next i


    'Now I use the same code for the second column, and just switch the column numbers.
    For i = 1 To lastrow
        For j = 1 To lastrow
            If Report.Cells(i, 2).Value <> "" Then
                If InStr(1, Report.Cells(j, 1).Value, Report.Cells(i, 2).Value, vbTextCompare) > 0 Then
                    Report.Cells(i, 2).Interior.Color = RGB(255, 255, 255) 'White background
                    Report.Cells(i, 2).Font.Color = RGB(0, 0, 0) 'Black font color
                    Exit For
                Else
                    Report.Cells(i, 2).Interior.Color = RGB(156, 0, 6) 'Dark red background
                    Report.Cells(i, 2).Font.Color = RGB(255, 199, 206) 'Light red font color
                End If
            End If
        Next j
    Next i


Application.ScreenUpdating = True
End Sub

 

[Akuini]

Thanks, but i need a VBA solution and also i just need the differences highlighted.
This is what i use now, but this is just seeing the differences as in missings, not the duplicates (most of the VBA code is from internet, credit to who create it...)

Try this:
Assuming the data start at A1.

Sub a1082482a()
'https://www.mrexcel.com/forum/excel-questions/1082482-compare-columns.html
Dim i As Long, j As Long
Dim a As Range, b As Range
Dim va As Variant, vb As Variant
Dim flag As Boolean

Set a = Range("A1", Cells(Rows.count, "A").End(xlUp))
Set b = Range("B1", Cells(Rows.count, "B").End(xlUp))
va = a
vb = b


For i = 1 To UBound(va, 1)
    flag = False
    For j = 1 To UBound(vb, 1)
        If va(i, 1) = vb(j, 1) Then
            vb(j, 1) = ""
            flag = True
            Exit For
        End If
    Next

    If flag = False Then Cells(i, "A").Font.Color = vbRed
Next

va = b
vb = a

For i = 1 To UBound(va, 1)
    flag = False
    For j = 1 To UBound(vb, 1)
        If va(i, 1) = vb(j, 1) Then
            vb(j, 1) = ""
            flag = True
            Exit For
        End If
    Next

    If flag = False Then Cells(i, "B").Font.Color = vbRed

Next

End Sub

 

[Jon von der Heyden]

or:

Public Sub IloveVBA()
    Dim rng1                As Excel.Range
    Dim rng2                As Excel.Range
    Dim rngCell             As Excel.Range
    Dim strJustynasFormula  As String
    
    Set rng1 = Range("A1:A19")
    Set rng2 = Range("B1:B19")
    
    strJustynasFormula = "COUNTIF(" & rng1.Address & ",{{c}}) {{op}} COUNTIF(" & rng2.Address & ",{{c}})"
    
    For Each rngCell In rng1
        If Evaluate(Replace$(Replace$(strJustynasFormula, "{{c}}", rngCell.Address), "{{op}}", ">")) Then
            rngCell.Font.ColorIndex = 3
        End If
    Next rngCell
    
    For Each rngCell In rng2
        If Evaluate(Replace$(Replace$(strJustynasFormula, "{{c}}", rngCell.Address), "{{op}}", "<")) Then
            rngCell.Font.ColorIndex = 3
        End If
    Next rngCell
End Sub

 

[dandana]

This look great @Akuini, thanks

 

[Akuini]

This look great @Akuini, thanks

You're welcome.