Find and Replace across Multiple Sheets

[adambriggs]

Hi all,

I am trying to write a Macro that will find and replace certain values across an entire workbook except on one worksheet. Basically I have one sheet called 'macro' where I have specified the find and replace terms. I would like to do it twice, namely:

Findtext = Sheets("Macro").Range("H8").Value
Replacetext = Sheets("Macro").Range("J8").Value

and

Findtext = Sheets("Macro").Range("H15").Value
Replacetext = Sheets("Macro").Range("J15").Value

Some of the sheets it will be replacing values in are likely to be hidden - I dont know if this causes a problem, but I would like it to apply to all hidden and unhidden sheets unless specified. I would prefer to keep it this way as over time more sheets are added and I'd prefer not to have to update the macro each time we add a new sheet. Also the second find and replace may find no relevant values so if there is someway of ignoring errors that would be ideal.

Finally, in the macro sheet I would like to be able to specify a file name path to save the file into, say in cell H20. I have no idea if possible but if the macro could save the file here and then close it that would be perfect.

Still a VBA beginner so any help would be much appreciated - attempts to hash together other macros on the net have not worked at all.

Thanks

[Tinbendr]

Not tested.

Option Explicit

Sub FindReplaceAcrossWB()
Dim WS As Worksheet
Dim iWS As Worksheet
Dim A As Long
Dim LastRow As Long
Dim C As Range, FirstAddress As String
Dim SrchAry(1 To 2, 1 To 2) As String

'Define array for Find/Replace
SrchAry(1, 1) = Sheets("Macro").Range("H8").Value
SrchAry(1, 2) = Sheets("Macro").Range("J8").Value

SrchAry(2, 1) = Sheets("Macro").Range("H15").Value
SrchAry(2, 2) = Sheets("Macro").Range("J15").Value

'Iterate all worksheets.
For Each iWS In Worksheets
    'Work with each sheet based on it's name.
    Select Case iWS.Name
    
    'Names of worksheets to skip.
    Case "WSNames to Skip", "Second WS to skip"
    
    Case Else 'all other worksheets to search.
        'Define ws as object
        Set WS = Worksheets(iWS)
        
        With WS
            'Determine lastrow of object WS.
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            'Define range to search.
            With .Range("A1:A" & LastRow)
                'Iterate the array of search items.
                For A = 1 To UBound(SrchAry)
                    'Make sure the element isn't empty.
                    If SrchAry(A, 1) <> "" Then
                        'Search, looking in values.
                        Set C = .Find(SrchAry(A, 1), LookIn:=xlValues)
                        'We found something
                        If Not C Is Nothing Then
                            'Record the first found address.
                            FirstAddress = C.Address
                            Do
                                'Replace the value.
                                C.Value = SrchAry(A, 2)
                                'Keep searching
                                Set C = .FindNext(C)
                            'Keep looking until conditions met.
                            Loop While Not C Is Nothing And C.Address <> FirstAddress
                        End If
                    End If
                Next
            End With
        End With
    End Select
Next

End Sub

[adambriggs]

Hi David

Thanks for the quick response. It seems to work up until " Set WS = Worksheets(iWS) " where it says type mismatch. Do I need to edit something at that point to make it specific to my workbook?

Apologies complete beginner.

Thanks,

[Tinbendr]

That should be

Set WS = Worksheets(iWS.Name)

Actually, it could be

        'Define ws as object
        'Set WS = Worksheets(iWS)
        
        With iWS

[adambriggs]

Thanks again I have tried both - there is no compile error but nothing seems to happen when I run it. I currently have:

Option Explicit

Sub FindReplaceAcrossWB()
Dim WS As Worksheet
Dim iWS As Worksheet
Dim A As Long
Dim LastRow As Long
Dim C As Range, FirstAddress As String
Dim SrchAry(1 To 2, 1 To 2) As String

'Define array for Find/Replace
SrchAry(1, 1) = Sheets("Macro").Range("H8").Value
SrchAry(1, 2) = Sheets("Macro").Range("J8").Value

SrchAry(2, 1) = Sheets("Macro").Range("H15").Value
SrchAry(2, 2) = Sheets("Macro").Range("J15").Value

'Iterate all worksheets.
For Each iWS In Worksheets
'Work with each sheet based on it's name.
Select Case iWS.Name

'Names of worksheets to skip.
Case "Macro" ', "Second WS to skip"

Case Else 'all other worksheets to search.
'Define ws as object
Set WS = Worksheets(iWS.Name)


'With iWS

With iWS
'Determine lastrow of object WS.
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

'Define range to search.
With .Range("A1:A" & LastRow)
'Iterate the array of search items.
For A = 1 To UBound(SrchAry)
'Make sure the element isn't empty.
If SrchAry(A, 1) <> "" Then
'Search, looking in values.
Set C = .Find(SrchAry(A, 1), LookIn:=xlValues)
'We found something
If Not C Is Nothing Then
'Record the first found address.
FirstAddress = C.Address
Do
'Replace the value.
C.Value = SrchAry(A, 2)
'Keep searching
Set C = .FindNext(C)
'Keep looking until conditions met.
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End If
Next
End With
End With
End Select
Next

End Sub

[Tinbendr]

You can comment out

'Set WS = Worksheets(iWS.Name)

Use F8 to step through the macro to see what it's doing. Hover over variables that should have values and see what the context pop shows you.

Telling me it doesn't work doesn't help me, help you.

Please use Code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

[adambriggs]

Apologies wasnt aware you could hover or how to code out. Hopefully the below is more useful to you.

The code I have now is as follows:

Option Explicit

Sub FindReplaceAcrossWB()
Dim WS As Worksheet
Dim iWS As Worksheet
Dim A As Long
Dim LastRow As Long
Dim C As Range, FirstAddress As String
Dim SrchAry(1 To 2, 1 To 2) As String

'Define array for Find/Replace
SrchAry(1, 1) = Sheets("Macro").Range("H8").Value
SrchAry(1, 2) = Sheets("Macro").Range("J8").Value

SrchAry(2, 1) = Sheets("Macro").Range("H15").Value
SrchAry(2, 2) = Sheets("Macro").Range("J15").Value

'Iterate all worksheets.
For Each iWS In Worksheets
    'Work with each sheet based on it's name.
    Select Case iWS.Name
    
    'Names of worksheets to skip.
    Case "Macro" ', "Second WS to skip"
    
    Case Else 'all other worksheets to search.
         'Define ws as object
        Set WS = Worksheets(iWS.Name)
        
        
        'With iWS
        
        With iWS
            'Determine lastrow of object WS.
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            'Define range to search.
            With .Range("A1:A" & LastRow)
                'Iterate the array of search items.
                For A = 1 To UBound(SrchAry)
                    'Make sure the element isn't empty.
                    If SrchAry(A, 1) <> "" Then
                        'Search, looking in values.
                        Set C = .Find(SrchAry(A, 1), LookIn:=xlValues)
                        'We found something
                        If Not C Is Nothing Then
                            'Record the first found address.
                            FirstAddress = C.Address
                            Do
                                'Replace the value.
                                C.Value = SrchAry(A, 2)
                                'Keep searching
                                Set C = .FindNext(C)
                            'Keep looking until conditions met.
                            Loop While Not C Is Nothing And C.Address <> FirstAddress
                            End If
                    End If
                Next
            End With
        End With
    End Select
Next

End Sub

In this line:

'Define ws as object
        Set WS = Worksheets(iWS.Name)

The value gives correct names of my worksheets and as I press F8 it changes as it cycles through.

In this line:

If SrchAry(A, 1) <> "" Then
                        'Search, looking in values.
                        Set C = .Find(SrchAry(A, 1), LookIn:=xlValues)
                        'We found something

The value shows as <Subscript out of range> for both SrchAry.

Set C = .Find(SrchAry(A, 1), LookIn:=xlValues)
                        'We found something
                        If Not C Is Nothing Then
                            'Record the first found address.
                            FirstAddress = C.Address
                            Do
                                'Replace the value.
                                C.Value = SrchAry(A, 2)

The C in the first line = Nothing. And the C.Address = <Object variable or With block variable not set>.

'Replace the value.
                                C.Value = SrchAry(A, 2)
                                'Keep searching
                                Set C = .FindNext(C)

And SrchAry(A, 2) = subscript out of range.

And

Set C = .FindNext(C)

This value also = Nothing.

Hope that helps and thanks again.

[Tinbendr]

Ok this seems to work. I forgot that you have to test c again. (Find really doesn't like you modifying the found value while it's running.)

Option Explicit

Sub FindReplaceAcrossWB()
Dim WS As Worksheet
Dim iWS As Worksheet
Dim A As Long
Dim LastRow As Long
Dim C As Range, FirstAddress As String, SecAddr As String
Dim SrchAry(1 To 2, 1 To 2) As String

'Define array for Find/Replace
SrchAry(1, 1) = Sheets("sheet1").Range("H8").Value
SrchAry(1, 2) = Sheets("Sheet1").Range("J8").Value

SrchAry(2, 1) = Sheets("Sheet1").Range("H15").Value
SrchAry(2, 2) = Sheets("Sheet1").Range("J15").Value

'Iterate all worksheets.
For Each iWS In Worksheets
    'Work with each sheet based on it's name.
    Select Case iWS.Name
    
    'Names of worksheets to skip.
    Case "Sheet1", "Second WS to skip"
    
    Case Else 'all other worksheets to search.
        'Define ws as object
        'Set WS = Worksheets(iWS)
        
        With iWS
            'Determine lastrow of object WS.
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            
            'Define range to search.
            With .Range("A1:A" & LastRow)
                'Iterate the array of search items.
                For A = 1 To UBound(SrchAry)
                    'Make sure the element isn't empty.
                    If SrchAry(A, 1) <> "" Then
                        'Search, looking in values.
                        Set C = .Find(SrchAry(A, 1), LookIn:=xlValues)
                        'We found something
                        If Not C Is Nothing Then
                            'Record the first found address.
                            FirstAddress = C.Address
                            Do
                                'Replace the value.
                                C.Value = SrchAry(A, 2)
                                'Keep searching
                                Set C = .FindNext(C)
                                If C Is Nothing Then Exit Do
                            'Keep looking until conditions met.
                            Loop While Not C Is Nothing And C.Address <> FirstAddress
                        End If
                    End If
                Next
            End With
        End With
    End Select
Next
End Sub

[adambriggs]

Hi,

Thanks again for your help. It seems to be progressing. So using F8 I followed it through and it went through the first sheet on my workbook, and the SrchAry values equalled those that I'm looking to replace. It then moved to the next sheet which is Macro and correctly skipped it and cycled back to the start. It then moved to the next sheet called MAIN. This is a data sheet with a number of seperate tables. On this sheet the SrchAry values went back to being subscript out of range as before. The other thing I noticed is that when hovering over last row in:

 'Define range to search.
            With .Range("A1:A" & LastRow)

It returned 21 for sheet MAIN when in fact the last row is 303. I think this might be because there are lots of sequential tables with gaps between them?

Thanks again.

[Tinbendr]

Yes! Those annoying tables. In that case...

Option Explicit

Sub FindReplaceAcrossWB()
Dim WS As Worksheet
Dim iWS As Worksheet
Dim A As Long
Dim LastRow As Long, Rng As Range
Dim C As Range, FirstAddress As String, SecAddr As String
Dim SrchAry(1 To 2, 1 To 2) As String

'Define array for Find/Replace
SrchAry(1, 1) = Sheets("sheet1").Range("H8").Value
SrchAry(1, 2) = Sheets("Sheet1").Range("J8").Value

SrchAry(2, 1) = Sheets("Sheet1").Range("H15").Value
SrchAry(2, 2) = Sheets("Sheet1").Range("J15").Value

'Iterate all worksheets.
For Each iWS In Worksheets
    'Work with each sheet based on it's name.
    Select Case iWS.Name
    
    'Names of worksheets to skip.
    Case "Sheet1", "Second WS to skip"
    
    Case Else 'all other worksheets to search.
        'Define ws as object
        'Set WS = Worksheets(iWS)
        
        With iWS
            'Determine lastrow of object WS.
            'LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            'http://www.rondebruin.nl/win/s9/win005.htm
            Set Rng = .Cells
            On Error Resume Next
            LastRow = Rng.Find(What:="*", _
                        After:=Rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
            On Error GoTo skip
            'Define range to search.
            With .Range("A1:A" & LastRow)
                'Iterate the array of search items.
                For A = 1 To UBound(SrchAry)
                    'Make sure the element isn't empty.
                    If SrchAry(A, 1) <> "" Then
                        'Search, looking in values.
                        Set C = .Find(SrchAry(A, 1), LookIn:=xlValues)
                        'We found something
                        If Not C Is Nothing Then
                            'Record the first found address.
                            FirstAddress = C.Address
                            Do
                                'Replace the value.
                                C.Value = SrchAry(A, 2)
                                'Keep searching
                                Set C = .FindNext(C)
                                If C Is Nothing Then Exit Do
                            'Keep looking until conditions met.
                            Loop While Not C Is Nothing And C.Address <> FirstAddress
                        End If
                    End If
skip:
                Next
            End With
        End With
    End Select
Next

End Sub

[adambriggs]

Great that last row bit seems to work. Getting close. Now when it goes through it seems to be working correctly and show the correct values but then it gets to C and says C is nothing even though on that sheet those values exist. So again no compile errors but no changes made.

Is this because I have said to look in values not formulas? Basically what I am trying to replace is a web reference string within a formula. Does this make a difference?

[Tinbendr]

Change it and give it a try.

Change xlvallues, to xlformulas

[adambriggs]

Doesn't seem to make a difference. The SrchAry Values always seem to be correct as I go through with F8. The problem seems to be (if this is a problem) is that C is always equal to nothing.

I have used the same find and replace values using the dialog box to make sure that Excel can find what I am looking for and can replace it and it works.

Is C=Nothing a problem and any ideas why it might always return that value?

Thanks again by the way!

[Tinbendr]

Don't know. It works fine on this sample file.

[Tinbendr]

Can you give me an example of the search/replace values?

[adambriggs]

/GHFK/Working Sheet/[Consolidated Data v01.xlsx] /CGI/Working Sheet/[Pack I Data v01.xlsx]

The value on the left is the find value and the one on the right is the replace. They are basically part of string such as https://xxx.sharepoint.com..../GHFK/Working Sheet/[Consolidated Data v01.xlsx]. Each relate to two different files so the idea is to replace the values to redirect all the references in a workbook to the new location.

Thanks,

Alex

[adambriggs]

Apologies that isnt very clear once published:

Find value: /GHFK/Working Sheet/[Consolidated Data v01.xlsx]

Replace Value: /CGI/Working Sheet/[Pack I Data v01.xlsx]

[adambriggs]

I have looked at the attached. It seems to work the first time I run the macro, however if I then change the values to anything random and run it again, it doesnt seem to function?

Can you replicate this? Is the marco not resetting or something?

Thanks again

[Tinbendr]

Do you change the find/replace values again? Make the find whatever is on the sheet2?

[adambriggs]

Yeah so if I open the file and run the macro it works. Then if change the find values to something random like John and Sarah, and add a few of these valyes at random on sheet 2 or 3 the marco doesnt seem to replace them.

[adambriggs]

So looking at this again this morning I think Im getting there.

By changing this code:

 'Define range to search.
            With .Range("A1:AZ" & LastRow)

From Just A1:A to A1:AZ it now does replace values across the sheet - I think before it just seemed to work in column A. Is there a way for the marco to dynamically look for the horizontal end of the sheet since they all vary quite a lot.


The main issue now though is that I have also changed it to look in formulas as below:

'Search, looking in values.
                        Set C = .Find(SrchAry(A, 1), LookIn:=xlFormulas)

However the problem now is that it replaces the entire cell, not just the string. So in your example sheet if I put say "2222here" in to a cell, it will not replace it with "2222there", but with just "there".

Any more advice how I can set it to replace the specified string only would be much appreciated.

Full code here:

Option Explicit

Sub FindReplaceAcrossWB()
Dim WS As Worksheet
Dim iWS As Worksheet
Dim A As Long
Dim LastRow As Long, Rng As Range
Dim C As Range, FirstAddress As String, SecAddr As String
Dim SrchAry(1 To 2, 1 To 2) As String

'Define array for Find/Replace
SrchAry(1, 1) = Sheets("sheet1").Range("H8").Value
SrchAry(1, 2) = Sheets("Sheet1").Range("J8").Value

SrchAry(2, 1) = Sheets("Sheet1").Range("H15").Value
SrchAry(2, 2) = Sheets("Sheet1").Range("J15").Value

'Iterate all worksheets.
For Each iWS In Worksheets
    'Work with each sheet based on it's name.
    Select Case iWS.Name
    
    'Names of worksheets to skip.
    Case "Sheet1", "Second WS to skip"
    
    Case Else 'all other worksheets to search.
        'Define ws as object
        'Set WS = Worksheets(iWS)
        
        With iWS
            'Determine lastrow of object WS.
            'LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            'http://www.rondebruin.nl/win/s9/win005.htm
            Set Rng = .Cells
            On Error Resume Next
            LastRow = Rng.Find(What:="*", _
                        After:=Rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
            On Error GoTo skip
            'Define range to search.
            With .Range("A1:AZ" & LastRow)
                'Iterate the array of search items.
                For A = 1 To UBound(SrchAry)
                    'Make sure the element isn't empty.
                    If SrchAry(A, 1) <> "" Then
                        'Search, looking in values.
                        Set C = .Find(SrchAry(A, 1), LookIn:=xlFormulas)
                        'We found something
                        If Not C Is Nothing Then
                            'Record the first found address.
                            FirstAddress = C.Address
                            Do
                                'Replace the value.
                                C.Value = SrchAry(A, 2)
                                'Keep searching
                                Set C = .FindNext(C)
                                If C Is Nothing Then Exit Do
                            'Keep looking until conditions met.
                            Loop While Not C Is Nothing And C.Address <> FirstAddress
                        End If
                    End If
skip:
                Next
            End With
        End With
    End Select
Next

End Sub

[Tinbendr]

to dynamically look for the horizontal end of the sheet since they all vary quite a lot.

There is, but unless you just want to limit the replace within a certain column, I wouldn't worry about it. Just pick a Column that will always be outside the data range.

To change part, use the LookAt property.

Set C = .Find(SrchAry(A, 1), LookIn:=xlFormulas, lookat:=xlPart)