Compare Sheets with diff number of rows 1

[OMG_VBA_IS_GREAT]

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

 

[Andrzejek]

combo,
I guess your and my suggestions were ignored.

Oh, well.... :-(


---- Andy

There is a great need for a sarcasm font.

 

[combo]

Andy,
yes, good old VBA (anyway, it's VBA forum). My suggestion requires BI implemented in excel. Intermediate tables after unpivoting contain 3 columns and around 750k of rows each, they are linked with two fields and the third is compared. Power query (or get & transform in 2016) it's incredibly fast, tables are compared within 10 seconds (three output queries).

combo