How to VBA for Find and Replace (array) - trying to maximize efficiency

[VRoberts]

I need help. I am new to this forum, but I am trying to use VBA to find and replace using an array (since I found that it could shorten the run (process) time considerably). The issue I am having is that my current code takes about 20 minutes to complete and I have to do this twice. It loops through each sht (find the partial string) and replaces it. It is a lot. There are about 15 worksheets with 197 rows 102 columns of cell reference data I am trying to update. I was using a loop to check each cell (find/replace) and move on. This was taking forever to complete as I have about 11 WB to do this for. The concept is really straight-forward, I want to take a cell reference [='C:\Desktop\FolderNames\Archives\2020-2021[2020...'] and change it to [='C:\Desktop\FolderNames\Archives\2021-2022[2021...']. This works with the following code, but it takes forever.

'\\Loops thru all the sheets to replace the Monthly Log linked file names
For Each sht In ThisWorkbook.Worksheets
Sheet4.Range("C8").Value = sht.Name 'Displays TabName in cell C8
If sht.Name <> "Archive" Then
sht.Cells.Replace what:=fnd, replacement:=replc, Lookat:=xlPart, _
MatchCase:=False, searchformat:=False, ReplaceFormat:=False
End If 'find and replace
Next sht 'End of Loop [Find and Replace]

I tried to incorporate the code as an array; however, it searches for the actual cell value which does not match because it's not the cell value that I need to find/replace, but the cell reference that associates with that value. It is pulling data from different WB sources. I really need to find a quicker way to replace all of the cell reference [from old path to the new path]. Here is my array code attempt. Please note that I am still a baby/toddler to arrays.

'Loops thru all the sheets to replace the Monthly Log linked file names
For Each sht In ThisWorkbook.Worksheets
sht.Activate
'MsgBox sht.Name & " " & ActiveSheet.UsedRange.Rows.Count
'MsgBox sht.Name & " " & ActiveSheet.UsedRange.Columns.Count

myArray = ActiveSheet.UsedRange

On Error Resume Next
.Range("C16").Value = sht.Name 'Displays TabName in cell C16
If sht.Name <> "Archive" Then
For x = LBound(myArray, 1) To UBound(myArray, 2)
For i = LBound(myArray, 2) To UBound(myArray, 2)
'[Jul-Dec]
myArray(x, i).Replace What:=myArray(fnd_one, x), Replacement:=myArray(replc_one, x), Lookat:=xlPart, _
MatchCase:=False, searchformat:=False, ReplaceFormat:=False
Next i
Next x
One last part note - for proprietary purposes I cannot share the file. Thank you so much for your time.

 

[GWteB]

Hi @VRoberts, welcome to MrExcel message board!

The code below is most likely to do what you want.

Sub VRoberts()

    Const ORGREF As String = "[='C:\Desktop\FolderNames\Archives\2020-2021[2020...']"
    Const NEWREF As String = "[='C:\Desktop\FolderNames\Archives\2021-2022[2021...']"

    Dim sht     As Worksheet
    Dim rng     As Range
    Dim arr     As Variant
    Dim cl      As Long
    Dim rw      As Long
    Dim c       As Long
    Dim n       As Long

    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    n = ThisWorkbook.Worksheets.Count - 1
    For Each sht In ThisWorkbook.Worksheets

        If sht.Name <> "Archive" Then
            c = c + 1
            Application.StatusBar = "Processing sheet " & c & " of " & n & " - " & sht.Name
            Set rng = sht.UsedRange
            If Not rng Is Nothing Then

                arr = rng.Formula
                For rw = LBound(arr) To UBound(arr)
                    For cl = LBound(arr, 2) To UBound(arr, 2)
                        If Not IsEmpty(arr(rw, cl)) Then
                            If Len(arr(rw, cl)) >= Len(ORGREF) Then
                                arr(rw, cl) = VBA.Replace(arr(rw, cl), ORGREF, NEWREF)
                            End If
                        End If
                    Next cl
                Next rw
                rng.Formula = arr
                DoEvents
            End If
        End If
    Next sht
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
End Sub

 

[VRoberts]

@GWteB. You are amazing. It worked perfectly and wicked fast. I tip my hat off to you. Thanks a million!!

 

[GWteB]

Have been offline for awhile, thanks for letting me know.