Find and Replace name ranges

[hrm1220]

I've looked all over the net trying to find coding to help my need. I've found some through this web site, but unable to get it to work correctly. What I'm trying to create is if a customer clicks on the button to copy the sheet (which has 28+ different name ranges) that when the sheet is copied it find and replace the named ranges with the new sheet name.

Dim strTool As String
'
strTool = ActiveSheet.Name
    ActiveSheet.Unprotect
    Range("A1").Select
ActiveSheet.Select
    oldTool = ActiveSheet.Name
    ActiveSheet.Copy After:=ActiveSheet
    ActiveSheet.Select
  newTool = InputBox("What is the new sheet name?")
    ActiveSheet.Unprotect
     ActiveSheet.Name = newTool

  Dim sSheet, lRow, n, Toolname, rngTool
    sSheet = ActiveSheet.Name
    lRow = 1
    For Each n In ActiveSheet.Names
        If Split(Right(n.RefersTo, Len(n.RefersTo) - 1), "!")(0) Like "*" & sSheet & "*" Then
        Toolname = Split(Right(n.Name, Len(n.Name) - 10), "!" & oldTool)
        Application.Goto Reference:=oldTool & Toolname(1)
        rngTool = Selection.Address
        ActiveWorkbook.Names.Add Name:=newTool & Toolname(1), RefersTo:= _
        "=" & newTool & "!" & rngTool
         
            lRow = lRow + 1
        End If
    Next

 Cells.Replace What:=oldTool, Replacement:=newTool, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

I appreciate all your help.

Thanks

 

[PHV]

I quite don't understand what you are trying to do as the RefersTo property is automagically updated.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[hrm1220]

PH,

Thanks for pointing that out to me. I've corrected and now it works. This is the code I used:

Dim strTool As String
'
strTool = ActiveSheet.Name
    ActiveSheet.Unprotect
    Range("A1").Select
ActiveSheet.Select
    oldTool = ActiveSheet.Name
    ActiveSheet.Copy After:=ActiveSheet
    ActiveSheet.Select
  newTool = InputBox("What is the new sheet name?")
    ActiveSheet.Unprotect
    ActiveSheet.Name = newTool

  Dim sSheet, lRow, n, Toolname, rngTool
    sSheet = ActiveSheet.Name
    lRow = 1
    For Each n In ActiveSheet.Names
        If Split(Right(n.RefersTo, Len(n.RefersTo) - 1), "!")(0) Like "*" & newTool & "*" Then
        Toolname = Split(n.Name, "!")
        Application.Goto Reference:=Toolname(1)
[COLOR=green]
' need to delete copied name range before you can add the name range for the new sheet[/color]
        ActiveWorkbook.Names(Toolname(1)).Delete
        rngTool = Selection.Address
        Toolname1 = Split(Toolname(1), oldTool)
        ActiveWorkbook.Names.Add Name:=newTool & Toolname1(1), RefersTo:= _
        "=" & newTool & "!" & rngTool
         
            lRow = lRow + 1
        End If
    Next

 Cells.Replace What:=oldTool, Replacement:=newTool, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Thanks again.