Hi,
I have a spreadsheet that I am currently working on for a project. This spreadsheet has a lot of data in, the task at hand is to put in some sort of macro/coding that automatically highlights a row of data, as it is updated in a different sheet on the same document.
The are thousands of rows on this spreadsheet, hence highlighting the recently updated rows seems like the best solution.
I am trying to compare on two separate worksheets conditional formatting isn't working.
I found the following code which I am trying to use, however every time I try run it but Excel freezes up and closes.
Would you be able to advise?
Sub Compare()
'
' Macro1 Macro
'
' compare two different worksheets in the active workbook
CompareWorksheets Worksheets("Day1"), Worksheets("Services_gap_report")
End Sub
Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim diffB As Boolean
Dim r As Long, c As Integer, m 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..."
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
For i = 2 To lr2
diffB = True
Application.StatusBar = "Comparing cells " & Format(i / maxR, "0 %") & "..."
For r = 2 To lr1
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = ws1.Cells(r, c).FormulaLocal
cf2 = ws2.Cells(i, c).FormulaLocal
On Error GoTo 0
If cf1 = cf2 Then
diffB = False
Exit For
End If
Next r
If diffB Then
DiffCount = DiffCount + 1
ws2.Cells(i,c).Font.Bold = True
ws2.Cells(i, c).Interior.ColorIndex = 19
End If
Next i
Next c
Application.StatusBar = "Formatting the report..."
'Columns("A:IV").ColumnWidth = 10
m = maxR - DiffCount - 1
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox m & "cells contain different values!", vbInformation, _
"Compare" & ws1.Name & "with" & ws2.Name
End Sub
Thank you in advance
Bookmarks