Hi guys and gals! :-)
I really need to speed up this find & replace VBA, if at all possible, as it is currently taking 2 hours to complete.
The workbook has sheets named by day of the week and each sheet holds a row for each member of staff - these staff members each complete a time-sheet, which is then linked to the relevant day on the master performance workbook (which is what this macro updates).
The purpose of the macro is to update the workbook for a new week, replacing, for example, Week 12.13 with Week 13.13 in all links on all week day tabs.
It is not possible to have all time sheets/work books open, as some have the same name, plus there are that many of them that most NC/PCs here don't have the memory. I have attempted to compensate for this by making sure the performance tracker doesn't update when changing links, but it still takes 2 hours.
I have tried to use a PULL function, which was even slower - indirect is not possible, due to not being able to open all time sheets.
Any ideas much appreciated!
Option Explicit
Public Sub SetupNewWeek()
Dim StringToFind As String, StringToReplace As String
Dim wbk As Workbook
Dim wks As Worksheet
Dim wksStart As Worksheet
Dim AreaToSearch As Range
Dim IndividualCells As Range
Dim SheetsToLookup As Range
Dim LookupCells As Range
Set wbk = Application.ThisWorkbook
Set SheetsToLookup = Range("U4", "U10")
Let StringToReplace = Range("V22", "V22")
Let StringToFind = Range("V28", "V28")
'Debug.Print StringToFind
'Debug.Print StringToReplace
Set wksStart = wbk.ActiveSheet
For Each IndividualCells In SheetsToLookup
For Each wks In wbk.Worksheets
If (wks.Name = IndividualCells.Value) Then
wks.Select
Set AreaToSearch = Range("C10", "AS98")
For Each LookupCells In AreaToSearch
LookupCells.Value = Replace(LookupCells.Formula, StringToFind, StringToReplace, 1, 3)
Debug.Print Replace(LookupCells.Formula, StringToFind, StringToReplace, 1, 3)
Next LookupCells
wksStart.Select
End If
Debug.Print wks.Name
Next wks
Next IndividualCells
Dim ThisWeek As String
Let ThisWeek = Range("M112").Value
Application.ActiveWorkbook.SaveAs Filename:=ThisWeek, FileFormat:=xlExcel8, ConflictResolution:=xlLocalSessionChanges
End Sub
Bookmarks