Consulting

Results 1 to 6 of 6

Thread: Compare rows of two sheets based on multiple columns

  1. #1

    Compare rows of two sheets based on multiple columns

    Hi guys,

    I hope youre all doing well! So I want to compare two sheets and check if the entries of sheet 1 exist in sheet 2 and vice versa. The first challenge is that one "entry" is identified by all columns of one row. The second challenge is that there is no order of the rows.

    So i started a VBA macro which highlights the cells in sheet 2 which are not found in sheet 1.
    The code works fine when I have a primary key in the first column. But when I have different entries which only match in the first column, my code is not working properly. I somehow need to check the combination of all columns. So I need to concat the value of each column of a row and compare them (sheet 1 and sheet 2) or something similiar.

    Im really new to VBA so please go easy on me! Here is my code:

    Sub CompareSheets(shtSheet1 As String, shtSheet2 As String)
    
    Dim c As Integer, j As Integer, i As Integer, mydiffs As Integer, cnt1 As Integer, cnt2 As Integer
    Dim noexist As Integer
    
    'count the rows of each sheet
    cnt2 = Worksheets("Sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row
    cnt1 = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
    
    'For each cell in sheet2 that is not the same in Sheet1, color it yellow
    For i = 1 To cnt2
        For j = 1 To cnt1
            If ActiveWorkbook.Worksheets(shtSheet2).Cells(i, 1).Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(j, 1).Value Then
                For c = 2 To 22
                    If Not ActiveWorkbook.Worksheets(shtSheet2).Cells(i, c).Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(j, c).Value Then
                        ActiveWorkbook.Worksheets(shtSheet2).Cells(i, c).Interior.Color = vbYellow
                        mydiffs = mydiffs + 1
                    End If
                Next
            Exit For
            End If
            'when sheet2 has a new entry (meaning value is not in sheet1), color it red
            If j = cnt1 Then
                ActiveWorkbook.Worksheets(shtSheet2).Cells(i, 1).Interior.Color = vbRed
                noexist = noexist + 1
            End If
        Next
    Next
    
    ActiveWorkbook.Sheets(shtSheet2).Select
    
    End Sub
    I really dont need the highlighting, I just want to see which row is different in sheet 2 by e.g. new column called Expected Results. Heres an example file: example.xlsm
    When you execute my Code, youll see I get a much different result than I need.

    If I didnt explain my problem well enough, please feel free to ask. I would appreciate any help! Thank you in advance.


    Best regards

    Alex

  2. #2
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi skyzzn!
    Sub test()
    Dim sht1$, sht2$
    sht1 = "Sheet1"
    sht2 = "Sheet2"
    Call CompareSheets(sht1, sht2)
    End Sub
    Sub CompareSheets(shtSheet1 As String, shtSheet2 As String)
    Dim arr, arr1, d As Object, i&, j&, s$
    arr = Sheets(1).[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
      For j = 1 To UBound(arr, 2)
        s = s & "," & arr(i, j)
      Next j
      d(s) = ""
      s = ""
    Next i
    arr = Sheets(2).[a1].CurrentRegion
    For i = 2 To UBound(arr)
      For j = 1 To UBound(arr, 2) - 1
        s = s & "," & arr(i, j)
      Next j
      If d.exists(s) Then arr(i, UBound(arr, 2)) = "Found in Sheet1" Else arr(i, UBound(arr, 2)) = "Not Found in Sheet1"
      s = ""
    Next i
    Sheets(2).[d1].Resize(UBound(arr)) = Application.Index(arr, , 4)
    Sheets(2).Select
    End Sub

  3. #3

    Smile

    Quote Originally Posted by 大灰狼1976 View Post
    Hi skyzzn!
    Sub test()
    Dim sht1$, sht2$
    sht1 = "Sheet1"
    sht2 = "Sheet2"
    Call CompareSheets(sht1, sht2)
    End Sub
    Sub CompareSheets(shtSheet1 As String, shtSheet2 As String)
    Dim arr, arr1, d As Object, i&, j&, s$
    arr = Sheets(1).[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
      For j = 1 To UBound(arr, 2)
        s = s & "," & arr(i, j)
      Next j
      d(s) = ""
      s = ""
    Next i
    arr = Sheets(2).[a1].CurrentRegion
    For i = 2 To UBound(arr)
      For j = 1 To UBound(arr, 2) - 1
        s = s & "," & arr(i, j)
      Next j
      If d.exists(s) Then arr(i, UBound(arr, 2)) = "Found in Sheet1" Else arr(i, UBound(arr, 2)) = "Not Found in Sheet1"
      s = ""
    Next i
    Sheets(2).[d1].Resize(UBound(arr)) = Application.Index(arr, , 4)
    Sheets(2).Select
    End Sub
    Hi 大灰狼1976 (i hope thats your right name),

    thank you alot for your code. Its working with my example excel really well!

    Just a quick question: The columns in my example may vary, so sometimes I have 5 columns in sheet 1 and sheet 2, sometimes 10 columns in sheet 1 and sheet 2. Is it possible to get this code working with a different amount of columns? So I get the new 'expected result' always as last column in sheet 2, independent of the number of columns.

    Thank you so much!


    Best Regards

    Alex

  4. #4
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    Hi skyzzn!
    Please refer to the Attachment.
    Now it can be dynamically processed according to the data range.
    Attached Files Attached Files

  5. #5
    You are the best! You helped me alot. Thanks for your time and awesome solution


    Best regards

    Alex

  6. #6
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    479
    Location
    that's alright

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •