dandana

New Member
Joined
Jan 3, 2019
Messages
3
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

DWB010DWB010
DWB251DWB251
DWB253DWB253
DWB931DWD860
DWD860DWD860
DWD860DWD861
DWD861DWD862
DWD862DWD911
DWD911DWD912
DWD912DWD913
DWD913DWD914
DWD914DWD915
DWD915DWD920
DWD920DWD922
DWD922DWD966
DWD966DWD966
DWD967DWD967
DWD968DWD968
EBO101EBO101

<colgroup><col span="2"></colgroup><tbody>
</tbody>
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
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.
 
Upvote 0
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...)

Code:
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
 
Upvote 0
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.

Code:
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
 
Upvote 0
or:
Code:
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,198
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top