Pages

Saturday, April 19, 2014

Compare two worksheet ranges from same or different workbook and identify the difference

Macro to compare two worksheet ranges in same or different workbook and identify cell address which does not match-

Sub compare_range()

    Dim basewkb As Workbook
    Dim comparetowkb As Workbook
    Dim outputwkb As Workbook
    
    
    Dim basewks As Worksheet
    Dim comparetowks As Worksheet
    
    Dim baserng As Range
    Dim comparetorng As Range
    
    Dim rowcount As Long
    Dim columncount As Long
    Dim strow As Long
    
    'Set basewkb = ThisWorkbook 'use in case of same workbook
    Set basewkb = Workbooks.Open("C:\Documents and Settings\Ashish Koul\Desktop\New Folder\sample1.xlsx") 'use in case of external workbook
    
    'Set comparetowkb = ThisWorkbook 'use in case of same workbook
    Set comparetowkb = Workbooks.Open("C:\Documents and Settings\Ashish Koul\Desktop\New Folder\sample2.xlsx") 'use in case of external workbook
     
    Set basewks = basewkb.Sheets("Sheet1") ' set worksheet
    Set comparetowks = comparetowkb.Sheets("Sheet1") 'set worksheet
    
    
    Set baserng = basewks.Range("a1:b6")
    Set comparetorng = comparetowks.Range("a1:b6")
    
    If baserng.Columns.Count <> comparetorng.Columns.Count Or baserng.Rows.Count <> comparetorng.Rows.Count Then
            GoTo releaseobject:
        Else
            Set outputwkb = Workbooks.Add
            outputwkb.Sheets(1).Cells(1, 1).Value = "Base worksheet Name"
            outputwkb.Sheets(1).Cells(1, 2).Value = "Cell Address (Base worksheet)"
            outputwkb.Sheets(1).Cells(1, 3).Value = "Cell Value(Base worksheet)"
            outputwkb.Sheets(1).Cells(1, 4).Value = "CompareTo worksheet Name"
            outputwkb.Sheets(1).Cells(1, 5).Value = "Cell Address (CompareTo worksheet)"
            outputwkb.Sheets(1).Cells(1, 6).Value = "Cell Value (CompareTo worksheet)"
            strow = 2
            For rowcount = 1 To baserng.Rows.Count
                For columncount = 1 To baserng.Columns.Count
                    If baserng.Cells(rowcount, columncount).Value <> comparetorng.Cells(rowcount, columncount).Value Then
                    outputwkb.Sheets(1).Cells(strow, 1).Value = basewks.Name
                    outputwkb.Sheets(1).Cells(strow, 2).Value = baserng.Cells(rowcount, columncount).Address
                    outputwkb.Sheets(1).Cells(strow, 3).Value = baserng.Cells(rowcount, columncount).Value
                    outputwkb.Sheets(1).Cells(strow, 4).Value = comparetowks.Name
                    outputwkb.Sheets(1).Cells(strow, 5).Value = comparetorng.Cells(rowcount, columncount).Address
                    outputwkb.Sheets(1).Cells(strow, 6).Value = comparetorng.Cells(rowcount, columncount).Value
                    strow = strow + 1
                    End If
                Next
            Next
            outputwkb.Sheets(1).UsedRange.EntireColumn.AutoFit
    End If
    
releaseobject:
    basewkb.Close ' close in case of external workbook
    comparetowkb.Close 'close in case of external workbook
    Set baserng = Nothing
    Set comparetorng = Nothing
    Set basewks = Nothing
    Set comparetowks = Nothing
    Set basewkb = Nothing
    Set comparetowkb = Nothing

End Sub


2 comments:

  1. To Compare
    Set R1 = Range(S1.Cells(1, 1), S1.Cells.SpecialCells(xlCellTypeLastCell))
    Set R2 = Range(S2.Cells(1, 1), S2.Cells.SpecialCells(xlCellTypeLastCell))
    S3.Cells(1, 1).Formula = "=" & R1.Address(, , , True) & "=" & R2.Address(, , , True)
    bComp = S3.Cells(1, 1)

    ReplyDelete
  2. Set R1 = Range(S1.Cells(1, 1), S1.Cells.SpecialCells(xlCellTypeLastCell))
    Set R2 = Range(S2.Cells(1, 1), S2.Cells.SpecialCells(xlCellTypeLastCell))
    If R1.Count = R2.Count Then
    Set R3 = Range(S3.Cells(1, 1), S3.Cells(S2.Cells.SpecialCells(xlCellTypeLastCell).Row, S2.Cells.SpecialCells(xlCellTypeLastCell).Column))
    R3.Formula = "=" & R1.Address(, , , True) & "=" & R2.Address(, , , True)
    Set R = R3.Find(What:="FALSE", After:=S3.Cells(1, 1), LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True, SearchFormat:=False)
    bComp = R Is Nothing
    Else
    bComp = False
    End If

    ReplyDelete