Compare 2 excel sheets -Error Checking of entered names
 

Can anyone assist with an error check here
this allows the user to enter 2 sheet names
and compare them with output of differences in a 3rd
workbook.
I added the go to that is commented out in line 6(below) but it always goes to that go to ..
also there is a limitation as to the columns/rows compared and I cant figure out what that is.
I created this from a few other snippets of code online.
I am doing my best to teach myself :-)

Thanks so much!!

Private Sub CommandButton1_Click()

Dim SHEET1 As String

SHEET1 = InputBox("Enter Sheet Name")
Dim SHEET2 As String

SHEET2 = InputBox("Enter Another Sheet Name")

'On Error GoTo invalid

'invalid:
'MsgBox "One or both sheet names entered are invalid. Please re-enter."
'Exit Sub

CompareWorksheets Worksheets(SHEET1), Worksheets(SHEET2)


End Sub


Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
Application.ScreenUpdating = False
Application.StatusBar = "Creating the report..."
Set rptWB = Workbooks.Add
Application.DisplayAlerts = False
While Worksheets.Count 1
Worksheets(2).Delete
Wend
Application.DisplayAlerts = True
With ws1.UsedRange
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With ws2.UsedRange
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
If maxR < lr2 Then maxR = lr2
If maxC < lc2 Then maxC = lc2
DiffCount = 0
For c = 1 To maxC
Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = ws1.Cells(r, c).FormulaLocal
cf2 = ws2.Cells(r, c).FormulaLocal
On Error GoTo 0
If cf1 < cf2 Then
DiffCount = DiffCount + 1
Cells(r, c).Formula = "'" & cf1 & " < " & cf2
End If
Next r
Next c
Application.StatusBar = "Formatting the report..."
With Range(Cells(1, 1), Cells(maxR, maxC))
.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
On Error GoTo 0
End With
Columns("A:IV").ColumnWidth = 20
rptWB.Saved = True
If DiffCount = 0 Then
rptWB.Close False
End If
Set rptWB = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox DiffCount & " cells contain different data!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name



End Sub

Compare 2 excel sheets -Error Checking of entered names
 

Good Afternoon,

The reason that your error check causes you to always display an error is that it is placed in the wrong place in the sub. The messagebox and Exit Sub should happen AFTER the code tries to run. You can fix this by rearranging the sub (see code at the end of this post). As for the number limit, I suspect it has to do with the use of Integer vs Long. Integers max out at 32,767, while Long Integers max out at 2,147,483,647. When you are looking at comparing large spreadsheets, the bottom row may exceed the Integer limit, causing the issue. Do a find and replace in your module to replace all instances of "Integer" with "Long" and hopefully that will fix it.

Hope this helps,

Ben

Sub CommandButton1_Click()

Dim SHEET1 As String

SHEET1 = InputBox("Enter Sheet Name")
Dim SHEET2 As String

SHEET2 = InputBox("Enter Another Sheet Name")

On Error GoTo invalid
CompareWorksheets Worksheets(SHEET1), Worksheets(SHEET2)
Exit Sub

invalid:
MsgBox "One or both sheet names entered are invalid. Please re-enter."

End Sub