Add Usedrange property in the existing code

[JOEYSCLEE]

Hi, there
As per below link, found the useful code for comparing the original & updated spreadsheets.

However, the empty cells of updated worksheets have not been highlighted with yellow color after running the code (In the original worksheets, the same cell contained the data.)

Hence, I need your big help to modify it with the Usedrange property.

Meanwhile, if the column and/or row is added or deleted in the updated worksheet, there is the message pop -up for the deleted column/row / highlighted color for the new column/row.

http://www.vbaexpress.com/kb/getarticle.php?kb_id=1141

[SamT]

You are going to have to fix your post.

Please make the code "pretty" in the VBA Editor, copy it, then in our editor, click the hash tag icon, then press CTRL+V to paste between the new Code Formatting Tags.

[JOEYSCLEE]

Hi, Sam
Thank you for the reply! I just paste the code again.

Option Explicit

''===================================================================
'' Program: FindChanges
'' Desc: Given two workbooks (one original, one updated) in
'' the same directory location, with identical worksheet
'' names, this program finds and highlights all the
'' values in the updated sheet that are different from
'' those in original sheet.
'' Called by: [Button on spreadsheet]
'' Call: LastCell
'' Changes----------------------------------------------
'' Date Programmer Change
'' 02/16/12 Alex M. Written
''===================================================================
Sub FindChanges()
Dim wbkCtlPanel As Workbook
Dim wbkOrigFile As Workbook
Dim wbkUpdated As Workbook
Dim wrkCtlPanel As Worksheet
Dim wrkOrig As Worksheet
Dim wrkUpdate As Worksheet
Dim rngLastOrig As Range
Dim rngLastUpdate As Range
Dim FSO As FileSystemObject

Dim strFilepath As String
Dim strOrigFile As String
Dim strUpdated As String
Dim lngRowStart As Long
Dim lngColStart As Long
Dim lngPercent As Long
Dim N As Long
Dim Q As Long
Dim P As Long

Application.ScreenUpdating = False

Set wbkCtlPanel = ActiveWorkbook
Set wrkCtlPanel = wbkCtlPanel.Worksheets("Control Panel")

'get user-entered values for files and location
With wrkCtlPanel
strFilepath = .Range("B4").Value
strOrigFile = .Range("B5").Value
strUpdated = .Range("B6").Value
End With

'the base path which has to be searched for Files
Set FSO = New FileSystemObject
''check if the folder actually exists or not

If (Not (FSO.FolderExists(strFilepath))) Then
'the folder path is invalid. Exiting.
MsgBox strFilepath & vbCrLf & "is an Invalid Path!"
Exit Sub
End If

Workbooks.Open strFilepath & "/" & strOrigFile
Set wbkOrigFile = Workbooks(strOrigFile)

Workbooks.Open strFilepath & "/" & strUpdated
Set wbkUpdated = Workbooks(strUpdated)

For Each wrkUpdate In wbkUpdated.Worksheets
On Error GoTo ErrorSheetAdded
Set wrkOrig = wbkOrigFile.Worksheets(wrkUpdate.Name)
On Error GoTo 0

Set rngLastOrig = LastCell(wrkOrig)
Set rngLastUpdate = LastCell(wrkUpdate)

lngRowStart = Application.WorksheetFunction.Max(rngLastOrig.Row, rngLastUpdate.Row)
lngColStart = Application.WorksheetFunction.Max(rngLastOrig.Column, rngLastUpdate.Column)

With wrkUpdate
For P = lngColStart To 1 Step -1
For Q = lngRowStart To 1 Step -1
If .Cells(Q, P).Value <> vbNullString And _
wrkOrig.Cells(Q, P).Value <> vbNullString Then
'calculate percent complete, based on "area" of the spreadsheet
lngPercent = (100 * ((lngColStart - P) * (lngRowStart - Q) / (lngColStart * lngRowStart)))
Application.StatusBar = "Checking updated sheet " & wrkUpdate.Name & _
" for changes..." & lngPercent & "% Complete..."

If .Cells(Q, P).Value <> wrkOrig.Cells(Q, P).Value Then
'Highlight cell on updated sheet
With .Cells(Q, P).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
Next Q
Next P
End With

ResumeChecking:

Next wrkUpdate

MsgBox "Update check complete! All items on the updated sheet that are different " & _
"from those on the original sheet have been highlighted in yellow. Check the " & _
"highlighted areas manually to verify the program results.", vbInformation, vbNullString

Application.StatusBar = False

Set wbkCtlPanel = Nothing
Set wbkOrigFile = Nothing
Set wbkUpdated = Nothing
Set wrkCtlPanel = Nothing
Set wrkOrig = Nothing
Set wrkUpdate = Nothing
Set rngLastOrig = Nothing
Set rngLastUpdate = Nothing
Set FSO = Nothing

Application.ScreenUpdating = True

Exit Sub

ErrorSheetAdded:
MsgBox "ERROR! The updated file has a sheet named " & Chr(34) & wrkUpdate.Name & Chr(34) & _
" that did not exist in the original file. This sheet will not be checked. Click OK to continue.", _
vbExclamation, vbNullString

On Error GoTo 0

GoTo ResumeChecking
End Sub

'***(Note: I did not write the LastCell function, but I don't remember who did - if it
'was you, let me know who you are so I can give you credit!)***

Function LastCell(ws As Worksheet) As Range
Dim LastRow&, LastCol%

' Error-handling is here in case there is not any
' data in the worksheet

On Error Resume Next

With ws

' Find the last real row

LastRow& = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

' Find the last real column

LastCol% = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column

End With

' Finally, initialize a Range object variable for
' the last populated row.

Set LastCell = ws.Cells(LastRow&, LastCol%)

End Function

[Paul_Hossler]

If you use the [#] icon on the toolbar, it adds [ CODE ] and [/ CODE ] to the message area, and you can paste your code between them like this

It sets off the code, and makes it easier for others to read



Option Explicit

''===================================================================
'' Program: FindChanges
'' Desc: Given two workbooks (one original, one updated) in
'' the same directory location, with identical worksheet
'' names, this program finds and highlights all the
'' values in the updated sheet that are different from
'' those in original sheet.
'' Called by: [Button on spreadsheet]
'' Call: LastCell
'' Changes----------------------------------------------
'' Date Programmer Change
'' 02/16/12 Alex M. Written
''===================================================================
Sub FindChanges()
Dim wbkCtlPanel As Workbook
Dim wbkOrigFile As Workbook
Dim wbkUpdated As Workbook
Dim wrkCtlPanel As Worksheet
Dim wrkOrig As Worksheet
Dim wrkUpdate As Worksheet
Dim rngLastOrig As Range
Dim rngLastUpdate As Range
Dim FSO As FileSystemObject

Dim strFilepath As String
Dim strOrigFile As String
Dim strUpdated As String
Dim lngRowStart As Long
Dim lngColStart As Long
Dim lngPercent As Long
Dim N As Long
Dim Q As Long
Dim P As Long

Application.ScreenUpdating = False

Set wbkCtlPanel = ActiveWorkbook
Set wrkCtlPanel = wbkCtlPanel.Worksheets("Control Panel")

'get user-entered values for files and location
With wrkCtlPanel
strFilepath = .Range("B4").Value
strOrigFile = .Range("B5").Value
strUpdated = .Range("B6").Value
End With

'the base path which has to be searched for Files
Set FSO = New FileSystemObject
''check if the folder actually exists or not

If (Not (FSO.FolderExists(strFilepath))) Then
'the folder path is invalid. Exiting.
MsgBox strFilepath & vbCrLf & "is an Invalid Path!"
Exit Sub
End If

Workbooks.Open strFilepath & "/" & strOrigFile
Set wbkOrigFile = Workbooks(strOrigFile)

Workbooks.Open strFilepath & "/" & strUpdated
Set wbkUpdated = Workbooks(strUpdated)

For Each wrkUpdate In wbkUpdated.Worksheets
On Error GoTo ErrorSheetAdded
Set wrkOrig = wbkOrigFile.Worksheets(wrkUpdate.Name)
On Error GoTo 0

Set rngLastOrig = LastCell(wrkOrig)
Set rngLastUpdate = LastCell(wrkUpdate)

lngRowStart = Application.WorksheetFunction.Max(rngLastOrig.Row, rngLastUpdate.Row)
lngColStart = Application.WorksheetFunction.Max(rngLastOrig.Column, rngLastUpdate.Column)

With wrkUpdate
For P = lngColStart To 1 Step -1
For Q = lngRowStart To 1 Step -1
If .Cells(Q, P).Value <> vbNullString And _
wrkOrig.Cells(Q, P).Value <> vbNullString Then
'calculate percent complete, based on "area" of the spreadsheet
lngPercent = (100 * ((lngColStart - P) * (lngRowStart - Q) / (lngColStart * lngRowStart)))
Application.StatusBar = "Checking updated sheet " & wrkUpdate.Name & _
" for changes..." & lngPercent & "% Complete..."

If .Cells(Q, P).Value <> wrkOrig.Cells(Q, P).Value Then
'Highlight cell on updated sheet
With .Cells(Q, P).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End If
Next Q
Next P
End With

ResumeChecking:

Next wrkUpdate

MsgBox "Update check complete! All items on the updated sheet that are different " & _
"from those on the original sheet have been highlighted in yellow. Check the " & _
"highlighted areas manually to verify the program results.", vbInformation, vbNullString

Application.StatusBar = False

Set wbkCtlPanel = Nothing
Set wbkOrigFile = Nothing
Set wbkUpdated = Nothing
Set wrkCtlPanel = Nothing
Set wrkOrig = Nothing
Set wrkUpdate = Nothing
Set rngLastOrig = Nothing
Set rngLastUpdate = Nothing
Set FSO = Nothing

Application.ScreenUpdating = True

Exit Sub

ErrorSheetAdded:
MsgBox "ERROR! The updated file has a sheet named " & Chr(34) & wrkUpdate.Name & Chr(34) & _
" that did not exist in the original file. This sheet will not be checked. Click OK to continue.", _
vbExclamation, vbNullString

On Error GoTo 0

GoTo ResumeChecking
End Sub

'***(Note: I did not write the LastCell function, but I don't remember who did - if it
'was you, let me know who you are so I can give you credit!)***

Function LastCell(ws As Worksheet) As Range
Dim LastRow&, LastCol%

' Error-handling is here in case there is not any
' data in the worksheet

On Error Resume Next

With ws

' Find the last real row

LastRow& = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

' Find the last real column

LastCol% = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column

End With

' Finally, initialize a Range object variable for
' the last populated row.

Set LastCell = ws.Cells(LastRow&, LastCol%)

End Function

[SamT]

What Paul said, the same as I said in my first post.

Paul did it for you this time, but please, DIY next time. Thanks

[JOEYSCLEE]

Thanks Paul for the great help for teaching me how to use [#] icon on the toolbar to paste the VBA code!!

Hi, Sam...Noticed your comment. In fact, I did not know how to paste the code again with hash tag icon in the VBA Editor as per your previous mention. Anyway, I'll do it myself next time.