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
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
To Compare
ReplyDeleteSet 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)
Set R1 = Range(S1.Cells(1, 1), S1.Cells.SpecialCells(xlCellTypeLastCell))
ReplyDeleteSet 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