asked on

Excel VBA: compare rows by rows v3

Hello experts,

I have the following procedure reported at:
https://www.experts-exchange.com/questions/28997130/VBA-Compare-columns-row-by-row-based-config-sheet-v2.html
that I would like to use as a reference in order to cover the following requirement:

1-Perform comparison row by row based on fields reported in 1-Configuration sheet
2-Highlight the one’s that don’t match in red
3-Report the number of rows which don’t match in False related column and the one's which match in True related column

Additional information:

Check configuration should be simplified as following:
If an error is found in the configuration sheet exit sub and display msg:
Unable to proceed check that your config sheet is properly set up

I attached dummy file
If you have questions, please contact me.
Compare-columns-based-on-range-name.xlsx

Subodh Tiwari (Neeraj)

Please try something like this...

Dim tCnt As Long, fCnt As Long

Sub CompareRowsofTwoColumns()
Dim wsConfig As Worksheet, wsData As Worksheet
Dim lr As Long, dlr As Long
Dim Rng As Range, cell As Range
Dim ColRng1 As Range, ColRng2 As Range

Application.ScreenUpdating = False
Set wsConfig = Worksheets("1-Configuration")
Set wsData = Worksheets("2-Data")
lr = wsConfig.Cells(Rows.Count, 1).End(xlUp).Row

If lr < 2 Then
    MsgBox "Unable to proceed check that your config sheet is properly set up.", vbExclamation
    Exit Sub
End If

Set Rng = wsConfig.Range("A2:A" & lr)
For Each cell In Rng
    Set ColRng1 = wsData.Rows(1).Find(what:=cell.Value)
    Set ColRng2 = wsData.Rows(1).Find(what:=cell.Offset(0, 1).Value)
    
    If ColRng1 Is Nothing Then
        MsgBox "Column " & cell.Value & " is not found on " & wsData.Name & " Sheet.", vbExclamation
        Exit Sub
    ElseIf ColRng1 Is Nothing Then
        MsgBox "Column " & cell.Offset(0, 1).Value & " is not found on " & wsData.Name & " Sheet.", vbExclamation
        Exit Sub
    End If
    
    If (Not ColRng1 Is Nothing) And (Not ColRng2 Is Nothing) Then
        dlr = wsData.Cells(Rows.Count, ColRng1.Column).End(xlUp).Row
        Set ColRng1 = wsData.Range(wsData.Cells(2, ColRng1.Column), wsData.Cells(dlr, ColRng1.Column))
        Set ColRng2 = wsData.Range(wsData.Cells(2, ColRng2.Column), wsData.Cells(dlr, ColRng2.Column))
        
        CompareTwoColumns ColRng1, ColRng2
        cell.Offset(0, 2) = tCnt
        cell.Offset(0, 3) = fCnt
    End If
    tCnt = 0
    fCnt = 0
Next cell
Application.ScreenUpdating = True
End Sub

Sub CompareTwoColumns(Rng1 As Range, Rng2 As Range)
Dim i As Long
For i = 1 To Rng1.Cells.Count
    If Rng1.Cells(i) = Rng2.Cells(i) Then
        tCnt = tCnt + 1
        Rng1.Cells(i).Interior.ColorIndex = xlNone
        Rng2.Cells(i).Interior.ColorIndex = xlNone
    Else
        fCnt = fCnt + 1
        Rng1.Cells(i).Interior.ColorIndex = 3
        Rng2.Cells(i).Interior.ColorIndex = 3
    End If
Next i
End Sub

Open in new window

Luis Diaz

ASKER

Thank you Subodh, Almost perfect. Possible to add an additional check for field names. Currently in the procedure if I enter a wrong field column msgbox with exit sub is not displayed.

Thank you in advance for your help.

Subodh Tiwari (Neeraj)

It's already there. Look at the lines 24:30.
Just replace the line#27 with the following line...

ElseIf ColRng2 Is Nothing Then

Open in new window

ASKER CERTIFIED SOLUTION

Subodh Tiwari (Neeraj)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Luis Diaz

ASKER

Tested and it works! Thank you very much for your help!

Subodh Tiwari (Neeraj)

You're welcome!