Find Same Text Replace with Different Text in an Array on Multiple Worksheets

[sethjbr]

Good Evening Excel vba extraordinaires,

I have some experience with writing excel vba code, but this problem has me stumped. Basically, I have a workbook with 5 worksheets that are automatically generated from a template worksheet in the same workbook using the following code:

Sub SetupWorkbook()


'Turn off annoying screen updating feature
Application.ScreenUpdating = False


'First Select the Instructions worksheet if not already selected
Sheets("Instructions").Select


' Identify memory space for sites and site names
Dim Site As Range, SiteNames As Range


' Specify information to be included in memory space
Set SiteNames = Sheets("Instructions").Range("I3:I7")
Set SiteNames = Range(SiteNames, SiteNames.End(xlDown))


'This For loop creates a new worksheet for all the site names on the instruction sheet based upon the tmp worksheet template
For Each Site In SiteNames


' After running through this code a bunch of times, whenever site is a blank value, the for loop exits itself
If Site.Value = "" Then Exit For


Worksheets("tmp").Copy after:=ActiveSheet
ActiveSheet.Name = Site.Value


Next Site


'Go back to the Instructions Sheet where we started
Sheets("Instructions").Select
       
End Sub

Now, I have an array of values that I am looking to replace on each worksheet according to the following table:

WorksheetName	FindText	ReplacementText
Wrksheet1	SameText	DifferentText1
Wrksheet2	SameText	DifferentText2
Wrksheet3	SameText	DifferentText3
Wrksheet4	SameText	DifferentText4
Wrksheet5	SameText	DifferentText5

<tbody>
</tbody>

Essentially, the actions that I am seeking to perform are the following:

With the exception of the first worksheet "Instructions" and the last worksheet "tmp", I am looking to loop through the worksheets and change the same value of "SameText" wherever it is found on Wrksheet1 and replace it with the first value of the ReplacementText array. Then, for the next worksheet, find "SameText" again and replace it with the second value of the ReplacementText array. This loop would continue through the worksheets until no more values existed in the ReplacementText array.

I have the following code mostly working, except the result is that the same ReplacementText array value is replaced for SameText on every worksheet instead of using the next value of the ReplacementText array for each subsequent loop through the code.

Any assistance would be appreciated. But additional explanation of syntax and looping best practices as it relates to this problem would also be welcome.

Thank you very much!

Sub FindNReplace()


Sheets("Instructions").Select


   Dim ReplacementValuesArray As Variant
   Dim FindText As String
   Dim CurrentSheet As Worksheet
   Dim x As Integer
   
   'Set Replacement values from Instructions Sheet
   ReplacementValuesArray = Sheets("Instructions").Range("L3:L7").Value
   FindText = "SameText"
   
   'This for procedure loops to all sheets except Intructions and tmp sheets
        For Each CurrentSheet In Worksheets
        
            ' Avoid worksheets named "Instructions" and "tmp"
            If CurrentSheet.Name <> "Instructions" And CurrentSheet.Name <> "tmp" Then
            
            counter = 1    'Start the Worksheet counter
            CurrentSheet.Activate ' Activate the Worksheet in the loop
            
                    For x = 1 To UBound(ReplacementValuesArray)
                    
                        CurrentSheet.Cells.Replace what:=FindText, replacement:=ReplacementValuesArray, _
                        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                        SearchFormat:=False, ReplaceFormat:=False
                    Next x
            
            MsgBox CurrentSheet.Name 'Display worksheet in a MsgBox to the user


            End If
        Next
    
End Sub

 

[JoeMo]

Untested.

Sub FindNReplace()
   Dim ReplacementValuesArray As Variant
   Dim FindText As String
   Dim CurrentSheet As Worksheet
   Dim x As Integer
   
   'Set Replacement values from Instructions Sheet
   ReplacementValuesArray = Sheets("Instructions").Range("L3:L7").Value
   FindText = "SameText"
   
   'This for procedure loops to all sheets except Intructions and tmp sheets
  x = 1
        For Each CurrentSheet In Worksheets
            ' Avoid worksheets named "Instructions" and "tmp"
            If CurrentSheet.Name <> "Instructions" And CurrentSheet.Name <> "tmp" Then
                    CurrentSheet.Cells.Replace what:=FindText, replacement:=ReplacementValuesArray(x, 1), _
                    lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                    SearchFormat:=False, ReplaceFormat:=False
                    x = x + 1
                    If x = UBound(ReplacementValuesArray, 1) + 1 Then Exit For
            End If
        Next CurrentSheet
End Sub

 

[sethjbr]

@JoeMo

Thank you very much. Your code worked beautifully!

 

[JoeMo]

@JoeMo

Thank you very much. Your code worked beautifully!

You are welcome - thanks for the reply.