View Full Version : Add Usedrange property in the existing code
JOEYSCLEE
11-22-2016, 09:24 AM
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
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
11-22-2016, 06:32 PM
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
11-22-2016, 06:44 PM
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
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
11-22-2016, 09:09 PM
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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.