Search and Replace within Named Ranges - VBA for Excel

Question

I have an Excel spreadsheet with about a hundred named ranges. I'd like to run a script to find certain strings within those named ranges and replace it with another string. The problem is about changing the names of named ranges while keeping the underlying cell references the same.

The standard Excel Search and Replace function doesn't work on named ranges.

For example: Named range = "Turnover_Shop_ABC_2018", and I want to replace the text "Shop_ABC" with "Store_XYZ". There are a few strings that I need to search and replace for but the macro doesn't need to be complicated: I don't mind running the script and manually updating the search strings each time.

Any help very much appreciated!

Answer 1

That should be as simple as iterating through your list of names to change and doing this:

ActiveWorkbook.Names("SomeName").Name = "SomeOtherName"
Copy

Here's a routine that will do that for you:

Option Explicit
Option Compare Text

Sub ReplaceNamePart(vMapping As Variant)
Dim nm  As Name
Dim sOld As String
Dim sNew As String
Dim i As Long


For i = 1 To UBound(vMapping)
    sOld = vMapping(i, 1)
    sNew = vMapping(i, 2)
    For Each nm In ActiveWorkbook.Names
        If InStr(nm.Name, sOld) > 1 Then nm.Name = Replace(nm.Name, sOld, sNew)
    Next nm
Next i

End Sub
Copy

...and here's how you would call it:

Sub ReplaceNamePart_Caller()
Dim v As Variant

v = Range("NameChange").ListObject.DataBodyRange
ReplaceNamePart v
End Sub
Copy

That Caller sub requires you to put your name change mapping in an Excel Table like so:

...and to name that Table NameChange:

Here's an example of how things look before you run the code:

...and here's the result:

Answer 2

You can try something like this with inputboxes to enter strings to find and replace:

    Sub search_replace__string()

Dim nm

For Each nm In ActiveWorkbook.Names
On Error Resume Next

If nm.RefersToRange.Parent.Name <> ActiveSheet.Name Then GoTo thenextnamedrange

MsgBox nm.Name

With ThisWorkbook.ActiveSheet.Range(nm.Name)

Dim i, j, FirstRow, FirstCol, LastRow, LastCol As Long
Dim SelText, RepText, myStr As String

FirstRow = .Row
FirstCol = .Column
LastRow = .End(xlDown).Row
LastCol = .End(xlToRight).Column

 SelText = InputBox("Enter String", "Search for...")
 RepText = InputBox("Enter String", "Replace with...")
 If SelText = "" Then
 MsgBox "String not found"
 Exit Sub
 End If
 For j = FirstCol To LastCol
 For i = FirstRow To LastRow
 If InStr(Cells(i, j), SelText) Then

    myStr = Cells(i, j).Value
    Cells(i, j).Value = Replace(myStr, SelText, RepText)

 End If
 Next
 Next

End With

thenextnamedrange:
Next nm

End Sub
Copy