VBA to change the scope of Named Ranges from worksheet level to workbook

[FryGirl]

I found this code but it doesn't seem to do the trick. I have named ranges both worksheet and workbook level. I need to change all the worksheet level named ranges to workbook.

[FONT=Times New Roman][SIZE=3][COLOR=#000000]Public SubRescopeNamedRangesToWorksheet()[/COLOR][/SIZE][/FONT]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Dim wb As Workbook[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Dim ws As Worksheet[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Dim objName As Name[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Dim sWsName As String[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Dim sWbName As String[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Dim sRefersTo As String[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Dim sObjName As String[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Set wb = ActiveWorkbook[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Set ws = ActiveSheet[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    sWsName = ws.Name[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    sWbName = wb.Name[/FONT][/COLOR][/SIZE]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][/FONT]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    For Each objName In wb.Names[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]        If objName.Visible = True Then[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]            If InStr(1, objName.RefersTo,sWsName, vbTextCompare) Then[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]                sRefersTo = objName.RefersTo[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]                sObjName = objName.Name[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]                If objName.Parent.Name =sWbName Then[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]                    objName.Delete[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]                    ws.Names.AddName:=sObjName, RefersTo:=sRefersTo[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]                End If[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           End If[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]        End If[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]    Next objName[/FONT][/COLOR][/SIZE]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]

 

[JoeMo]

You can adapt this to your need.

Sub ChangeLocalNameAndOrScope()
'Programmatically change a sheet-level range name and/or scope to a new name and/or scope
Dim nm As Name, Ans As Integer, newNm As String
For Each nm In ActiveWorkbook.Names
    If nm.Name Like "*!*" Then 'It is sheet level
        Ans = MsgBox(nm.Name & " is a worksheet level name - do you want to change it?", vbYesNo)
        If Ans = vbYes Then
            newNm = InputBox("Enter new name - inculde 'Sheet1'! for a local name")
            If newNm = "" Then Exit Sub
            Range(nm.RefersTo).Name = newNm
            nm.Delete
        End If
    End If
Next nm
End Sub

 

[FryGirl]

Is there a way to just take the name of the named range as it is now instead of typing it in the InputBox?

 

[JoeMo]

Is there a way to just take the name of the named range as it is now instead of typing it in the InputBox?

Sure, try this:

Sub ChangeLocalNameAndOrScope()
'Programmatically change a sheet-level range name and/or scope to a new name and/or scope
Dim nm As Name, Ans As Integer, newNm As String
For Each nm In ActiveWorkbook.Names
    If nm.Name Like "*!*" Then 'It is sheet level
        newNm = Replace(nm.Name, "*!", "")
        Range(nm.RefersTo).Name = newNm
        nm.Delete
    End If
Next nm
End Sub

 

[FryGirl]

Thank you Joe. I can surely work with this.

 

[JoeMo]

Thank you Joe. I can surely work with this.

You are welcome - thanks for the reply.