OMG_VBA_IS_GREAT
Technical User
Hi All, I've been using the below code (took from this great website) and it works great when I have the same number of rows in sheet 1 and sheet 2. The problem I am having and I am struggling to resolve if one of the two sheets has different rows the macro displays diffs because the number of row are off. Not sure how to fix. Any help would be greatly appreciated.
Sub GetDiffs()
Dim lRow As Long, cols As Integer, i As Integer, refArr As Variant, CompArr As Variant
Dim refSht As Worksheet, compSht As Worksheet, incr As Long
Dim MaxRow1 As Long
Dim MaxCol1 As Integer
Set refSht = Sheets("Sheet1")
Set compSht = Sheets("Sheet2")
Application.ScreenUpdating = False
Sheets("Diff").Select
Columns("A:L").Select
Selection.Delete shift:=xlToLeft
Range("A1").Select
'Call CreateCommonHeaders
'Call Sort_Column_Headers_AtoZ
'Call Sort_Unique_ID 'Need to write code to sort Unique ID for each tab
lRow = refSht.UsedRange.Rows.Count
cols = refSht.UsedRange.Columns.Count
incr = 2
For i = 1 To cols
refSht.Select
refArr = refSht.Range(Cells(1, i), Cells(lRow, i))
compSht.Select
CompArr = compSht.Range(Cells(1, i), Cells(lRow, i))
For x = 1 To UBound(refArr)
If refArr(x, 1) <> CompArr(x, 1) Then
With Sheets("Diff")
.Cells(1, 1).Value = "Header Col Diff"
.Cells(1, 2).Value = "Diff Cell Location"
.Cells(1, 3).Value = "Umy Data"
.Cells(1, 4).Value = " MyData"
'.Cells(incr, 1).Value = "R" & x + 1 & "C" & i
.Cells(incr, 1).Value = refSht.Range(Cells(i).Address(RowAbsolute:=False, ColumnAbsolute:=False)).Value
.Cells(incr, 2).Value = Cells(x + 1, i).Address(RowAbsolute:=False, ColumnAbsolute:=False)
.Cells(incr, 3).Value = refArr(x, 1)
.Cells(incr, 4).Value = CompArr(x, 1)
incr = incr + 1
End With
Else
End If
Next
Next i
Sheets("Diff").Select
With Sheets("Diff").UsedRange '
LastRow1 = .Rows.Count
LastCol1 = .Columns.Count
End With
MaxRow1 = LastRow1
MaxCol1 = LastCol1
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(MaxRow1, MaxCol1))
.Interior.ColorIndex = 19
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error Resume Next
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With Range(Cells(1, 1), Cells(1, MaxCol1)).Select
With Selection
.Interior.ColorIndex = 15
End With
End With
Columns("C").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
End With
Columns("A:L").AutoFit
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox ("Recon Complete!!")
End Sub
Sub GetDiffs()
Dim lRow As Long, cols As Integer, i As Integer, refArr As Variant, CompArr As Variant
Dim refSht As Worksheet, compSht As Worksheet, incr As Long
Dim MaxRow1 As Long
Dim MaxCol1 As Integer
Set refSht = Sheets("Sheet1")
Set compSht = Sheets("Sheet2")
Application.ScreenUpdating = False
Sheets("Diff").Select
Columns("A:L").Select
Selection.Delete shift:=xlToLeft
Range("A1").Select
'Call CreateCommonHeaders
'Call Sort_Column_Headers_AtoZ
'Call Sort_Unique_ID 'Need to write code to sort Unique ID for each tab
lRow = refSht.UsedRange.Rows.Count
cols = refSht.UsedRange.Columns.Count
incr = 2
For i = 1 To cols
refSht.Select
refArr = refSht.Range(Cells(1, i), Cells(lRow, i))
compSht.Select
CompArr = compSht.Range(Cells(1, i), Cells(lRow, i))
For x = 1 To UBound(refArr)
If refArr(x, 1) <> CompArr(x, 1) Then
With Sheets("Diff")
.Cells(1, 1).Value = "Header Col Diff"
.Cells(1, 2).Value = "Diff Cell Location"
.Cells(1, 3).Value = "Umy Data"
.Cells(1, 4).Value = " MyData"
'.Cells(incr, 1).Value = "R" & x + 1 & "C" & i
.Cells(incr, 1).Value = refSht.Range(Cells(i).Address(RowAbsolute:=False, ColumnAbsolute:=False)).Value
.Cells(incr, 2).Value = Cells(x + 1, i).Address(RowAbsolute:=False, ColumnAbsolute:=False)
.Cells(incr, 3).Value = refArr(x, 1)
.Cells(incr, 4).Value = CompArr(x, 1)
incr = incr + 1
End With
Else
End If
Next
Next i
Sheets("Diff").Select
With Sheets("Diff").UsedRange '
LastRow1 = .Rows.Count
LastCol1 = .Columns.Count
End With
MaxRow1 = LastRow1
MaxCol1 = LastCol1
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(MaxRow1, MaxCol1))
.Interior.ColorIndex = 19
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
On Error Resume Next
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
End With
With Range(Cells(1, 1), Cells(1, MaxCol1)).Select
With Selection
.Interior.ColorIndex = 15
End With
End With
Columns("C").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
End With
Columns("A:L").AutoFit
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox ("Recon Complete!!")
End Sub