compare columns

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>
 

JustynaMK

Active Member
Joined
Aug 28, 2016
Messages
436
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

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

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,245
Office Version
2013
Platform
Windows
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
 

Jon von der Heyden

MrExcel MVP, Moderator
Joined
Apr 6, 2004
Messages
10,685
Office Version
365
Platform
Windows
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:

Forum statistics

Threads
1,077,729
Messages
5,335,881
Members
399,055
Latest member
Telman86

Some videos you may like

This Week's Hot Topics

Top