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

VRoberts

New Member
Joined
Jul 23, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
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.
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,482
Office Version
  1. 2013
Platform
  1. Windows
Hi @VRoberts, welcome to MrExcel message board!

The code below is most likely to do what you want.
VBA Code:
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

New Member
Joined
Jul 23, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
@GWteB. You are amazing. It worked perfectly and wicked fast. I tip my hat off to you. Thanks a million!!
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,482
Office Version
  1. 2013
Platform
  1. Windows
Have been offline for awhile, thanks for letting me know.
 

Forum statistics

Threads
1,148,422
Messages
5,746,589
Members
424,032
Latest member
pochie2741

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top