I have a workbook that provides updates to our timesheet workbook. For some reason, I cannot get the code to execute the update. It doesn't crash, and appears to run fine, yet the update doesn't occur.
Can someone see where I am going wrong here?
Code
Option Explicit
Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim Cell As Range
Dim rngdata As Range
'
If MsgBox("You are about to Run and Update on all Timesheets, Do you want to proceed?", _
vbYesNo, "Timesheet Update Manager") = vbYes Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
'----------------------------------------------------------------------------------------------
'
Set wbCodeBook = ThisWorkbook
'
With Application.FileSearch
.NewSearch
'Change path to suit
Set rngdata = Sheets("FileCheck").Range("H2") 'This cell provides path for files to update
For Each Cell In rngdata
.LookIn = Cell.Value
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all.
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
' Update code execution area for all Employee Timesheets
'
'**********Enter Update Information Here*********
'
Dim ws As Worksheets
'
For Each ws In ActiveWorkbook.Sheets
ws.Unprotect Password:="light"
Range("D7:AH87").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween, Formula1:="0", Formula2:="24"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = "Invalid Entry"
.InputMessage = ""
.ErrorMessage = "Numerical value only. No Text may be entered."
.ShowInput = True
.ShowError = True
End With
ws.Protect Password:="light"
Next ws
'
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'----------------------------------------------------------------------------------------------
'
wbResults.Close SaveChanges:=True
Next lCount
End If
Next Cell
End With
On Error GoTo 0
'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
MsgBox "Update Complete"
Else
MsgBox "Update NOT Executed!!"
End If
End Sub