Results 1 to 2 of 2
  1. #1
    Lounger
    Join Date
    Aug 2013
    Posts
    45
    Thanks
    11
    Thanked 0 Times in 0 Posts

    Compare 2 sheets

    Hello,

    This script works like a charm on single column comparing two sheets, I want to do comparing on 2 colums condition.
    Column 'D' and Column 'F' . I tried but could not get results. Needs help.

    Code:
    Option Explicit
    
    Private Sub cmdCompare2to1_Click()
    
    Dim sheet1 As Worksheet, sheet2 As Worksheet, sheet3 As Worksheet
    Dim lngLastR As Long, lngCnt As Long
    Dim var1 As Variant, var2 As Variant, x
    Dim rng1 As Range, rng2 As Range
    
    
    Set sheet1 = Worksheets(1)
    Set sheet2 = Worksheets(2)
    Set sheet3 = Worksheets(3) ' assumes sheet3 is a blank sheet in your workbook
    
    Application.ScreenUpdating = False
    
    'let's get everything all set up
    'sheet3 column headers
    sheet3.Range("A1:B1").Value = Array("in1Not2", "in2Not1")
    
    'sheet1 range and fill array
    With sheet1
    
        lngLastR = .Range("D" & .Rows.Count).End(xlUp).Row
    
        Set rng1 = .Range("D1:D" & lngLastR)
        var1 = rng1
    
    End With
    
    'sheet2 range and fill array
    With sheet2
    
        lngLastR = .Range("D" & .Rows.Count).End(xlUp).Row
    
        Set rng2 = .Range("D1:D" & lngLastR)
        var2 = rng2
    
    End With
    
    'first check sheet1 against sheet2
    On Error GoTo NoMatch1
    For lngCnt = 1 To UBound(var1)
    
        x = Application.WorksheetFunction.Match(var1(lngCnt, 1), rng2, False)
    
    Next
    
    'now check sheet2 against sheet1
    On Error GoTo NoMatch2
    For lngCnt = 1 To UBound(var2)
    
        x = Application.WorksheetFunction.Match(var2(lngCnt, 1), rng1, False)
    
    Next
    
    On Error GoTo 0
    Application.ScreenUpdating = True
    Exit Sub
    
    NoMatch1:
        sheet3.Range("A" & sheet3.Rows.Count).End(xlUp).Offset(1) = var1(lngCnt, 1)
        Resume Next
    
    NoMatch2:
        sheet3.Range("B" & sheet3.Rows.Count).End(xlUp).Offset(1) = var2(lngCnt, 1)
        Resume Next
    End Sub

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    You were not very specific on your needs. This compares the combined D&F in Sht1 to the combined D&F in Sheet2, instread of just comparing D to D. I did not re-write the code at all except to add this feature. This should allow other updates by you in the future.
    Code:
    Option Explicit
    
    Private Sub cmdCompare2to1_Click()
    
    Dim sheet1 As Worksheet, Sheet2 As Worksheet, Sheet3 As Worksheet
    Dim lngLastR As Long, lngCnt As Long
    Dim var1() As Variant, var2() As Variant, x
    Dim rng1 As Range, rng2 As Range
    
    
    
    Set sheet1 = Worksheets(1)
    Set Sheet2 = Worksheets(2)
    Set Sheet3 = Worksheets(3) ' assumes sheet3 is a blank sheet in your workbook
    
    'Application.ScreenUpdating = False
    
    'let's get everything all set up
    'sheet3 column headers
    Sheet3.Range("A1:B1").Value = Array("in1Not2", "in2Not1")
    
    'sheet1 range and fill array
    With sheet1
        lngLastR = .Range("D" & .Rows.Count).End(xlUp).Row
        lngCnt = lngLastR
        lngLastR = .Range("F" & .Rows.Count).End(xlUp).Row
        If lngLastR > lngCnt Then lngCnt = lngLastR
        Set rng1 = .Range("D1:D" & lngLastR)
        Set rng2 = .Range("F1:F" & lngLastR)
        ReDim var1(1 To lngLastR)
        For x = 1 To lngLastR
          var1(x) = rng1(x) & rng2(x)
        Next
    End With
    
    'sheet2 range and fill array
    With Sheet2
        lngLastR = .Range("D" & .Rows.Count).End(xlUp).Row
        lngCnt = lngLastR
        lngLastR = .Range("F" & .Rows.Count).End(xlUp).Row
        If lngLastR > lngCnt Then lngCnt = lngLastR
        Set rng1 = .Range("D1:D" & lngLastR)
        Set rng2 = .Range("F1:F" & lngLastR)
        ReDim var2(1 To lngLastR)
        For x = 1 To lngLastR
          var2(x) = rng1(x) & rng2(x)
        Next
    End With
    
    'first check sheet1 against sheet2
    On Error GoTo NoMatch1
    For lngCnt = 1 To UBound(var1)
        x = Application.WorksheetFunction.Match(var1(lngCnt), var2, False)
    Next
    
    'now check sheet2 against sheet1
    On Error GoTo NoMatch2
    For lngCnt = 1 To UBound(var2)
    
        x = Application.WorksheetFunction.Match(var2(lngCnt), var1, False)
    
    Next
    
    On Error GoTo 0
    Application.ScreenUpdating = True
    Exit Sub
    
    NoMatch1:
        Sheet3.Range("A" & Sheet3.Rows.Count).End(xlUp).Offset(1) = var1(lngCnt)
        Resume Next
    
    NoMatch2:
        Sheet3.Range("B" & Sheet3.Rows.Count).End(xlUp).Offset(1) = var2(lngCnt)
        Resume Next
    End Sub
    Steve

Posting Permissions

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