Home |
Search |
Today's Posts |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Rachel,
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 formulas!", vbInformation, _ "Compare " & ws1.Name & " with " & ws2.Name End Sub Regards, Sanjay Mark "Yes", if the post is helpful "Rachel" wrote: HI, Anyone can help? I need a macro code to count number of used rows in two seperate worksheets and compare. If the number do not match error message shall appear "Sheet1 has (blank) number and Sheet2 has (blank) number". (blank) being the number of used rows per sheet. Can this be done? thanks! |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do I count the number of worksheets used in a file? | Excel Discussion (Misc queries) | |||
Command to count number of worksheets in a workbook? | Excel Worksheet Functions | |||
Count number of rows, where non relevant rows are hidden | Excel Discussion (Misc queries) | |||
Count rows and insert number to count them. | Excel Discussion (Misc queries) | |||
Count the number of worksheets in a workbook | Excel Discussion (Misc queries) |