Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do i compare and remove common names from 2 excel work sheets | Excel Worksheet Functions | |||
Excel compare names | Excel Worksheet Functions | |||
Compare Two Sheets Generates Runtime Error 13 | Excel Programming | |||
Checking names on correct line across sheets | Excel Worksheet Functions | |||
How do I compare two lists of names in excel? | Excel Discussion (Misc queries) |