I have about 300 named ranges that are referring to an external spreadsheet.
for example
Range name: my_range
Refers to: ='\mycompany.com\lucas[Lucas.xlsm]SHEETNAME'!$C$10
I want to replace the "\mycompany.com\lucas[Lucas.xlsm]" with an empty string
I tried researching this online but it doesn't seem like I'm able to phrase it correctly, all the answers are referring to find and replace in cells...
There are a number of resources for doing this in VBA (300+ is a lot to do by hand!).
A great general guide is here: The SpreadsheetGuru's guide to Named Ranges in VBA
To loop through all named ranges and all named ranges in a specific worksheet:
Sub NamedRange_Loop()
'PURPOSE: Delete all Named Ranges in the Active Workbook
'SOURCE: www.TheSpreadsheetGuru.com
Dim nm As Name
'Loop through each named range in workbook
For Each nm In ActiveWorkbook.Names
Debug.Print nm.Name, nm.RefersTo
Next nm
'Loop through each named range scoped to a specific worksheet
For Each nm In Worksheets("Sheet1").Names
Debug.Print nm.Name, nm.RefersTo
Next nm
End Sub
To change the link, instead of using Debug.Print, edit the RefersTo. I can't find a way to directly edit the link, all the documentation suggest that you'd have to delete the link and recreate it with a new reference.
Deleting is easy - nm.Delete
Creating is easy:
'For Workbook level links
ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell
'For Worksheet level links
Worksheets("Sheet1").Names.Add Name:=RangeName, RefersTo:=cell
See also:
Names Object
Names.Add Method
Defining and using names in VBA formulas
Looping through all named ranges in excel VBA in current active sheet
If you replace the referring address of a named range with an empty string, Excel deletes the named range. And this is the way I am using to delete a named range:
Public Sub DeleteName(sName As String)
On Error GoTo DeleteName_Error
ActiveWorkbook.Names(sName).Delete
Debug.Print sName & " is deleted!"
On Error GoTo 0
Exit Sub
DeleteName_Error:
Debug.Print sName & " not present or some error"
On Error GoTo 0
End Sub
Simply call it like this:
DeleteName my_range
Actually, the deletion of the named range without .RefersTo is quite clever by the Excel developers - otherwise plenty of errors would appear. Check it out, this code would run only once if you declare my_range1 and my_range2:
Public Sub TestMe()
Dim nameArray As Variant
nameArray = Array("my_range1", "my_range2")
Dim myNameRange As Name
For Each myNameRange In ThisWorkbook.Names
Dim cnt As Long
For cnt = LBound(nameArray) To UBound(nameArray)
If nameArray(cnt) = myNameRange.Name Then
Debug.Print myNameRange
Debug.Print myNameRange.RefersTo
myNameRange.RefersTo = vbNullString
End If
Next cnt
Next myNameRange
End Sub
You should be able to do that from the Data, Edit Links dialog. Select the link in question, click change source and point it to the workbook itself.
If that fails, download my FlexFind tool (http://jkp-ads.com/officemarketplaceff-en.asp), run it and make sure you check the Objects checkbox on the dialog.
Related
Sub BreakLinks()
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
End If
End Sub
This code breaks all the external links the active workbook. How can I do it for a selected range in a particular sheet ?
Also, I want to first show the external links in a list(from the selected range), and then 2 buttons : 1 to delete them and 2nd to cancel.
Any help would be appreciated.
LinkSources(xlExcelLinks) is a method of the Workbook - MSDN Workbook.LinkSources, thus it is does not provide .BreakLink to cells.
However, you can loop through the cells with formulas in a given range (givenRange.SpecialCells(xlCellTypeFormulas)) and check whether they contain [, which is needed for the link formula. If they have it, simply write the formulas as values:
Option Explicit
Sub BreakLinks()
Dim givenRange As Range
Set givenRange = Selection
Dim myCell As Range
For Each myCell In givenRange.SpecialCells(xlCellTypeFormulas)
If InStr(myCell.Formula, "[") Then
Debug.Print myCell.Address
myCell.Value2 = myCell.Value2
End If
Next myCell
End Sub
Solution:
1: Create a userform containing a list where all the external links will be listed
2: Set a custom range on a specific sheet and loop through the cells on that range using:
.SpecialCells(xlCellTypeFormulas)
3: Find the cells that contain an external link using:
InStr(1, rCell.Formula, "[") > 0 Then
4: Redim your array and store the cell.address in your array
5: Fill your listbox on your userform through your array (one could also just immediately fill the listbox in the initial loop)
6: Select a value in your listbox and use a button to delete the external link (use find or make sure you have stored your cell.address)
7: You could make your list a multiselect one offcourse.....
EDIT Basically what #Vityata explains in code aswell (beaten me to it :))
I am writing my first script with VBA and I am having a hard time assigning the value entered into a cell to a String variable, I used Message Boxes to test where the issue is and it showed me I'm in the right workbook and the right sheet but then shows a blank for the value in "A1" even though I have a text value there and made sure I saved the workbook, what I have is below:
Sub copyworksheet()
Dim sourceWorkbook As String
Dim destinationWorkbook As String
Dim folderName As String
destinationWorkbook = ActiveWorkbook.Name
Sheets(1).Activate
MsgBox Range("A1").Value ' Shows blank when debugging
folderName = Range("A1").Value
MsgBox "Here is " & folderName ' Shows "Here is " when debugging
End Sub
** As an additional note, the A1 cell contains 02Nov, and I have tried changing the format of this cell and it hasn't fixed the issue, currently the cell format is Text
I think this should do the trick:
Sub copyworksheet()
Dim sourceWorkbook As String
Dim destinationWorkbook As String
Dim folderName As String
destinationWorkbook = ActiveWorkbook.Name
MsgBox Sheets(1).Range("A1").Value 'reference the Sheet absolutely when using Range
folderName = Sheets(1).Range("A1").Value
MsgBox "Here is " & folderName
End Sub
Alternate way is using Cells.
MsgBox Cells(1, 1).Value
folderName = Cells(1, 1).Value
Sheets(1)
refers to the first tab in the active workbook. That tab can be a worksheet, code sheet or chart sheet.
It is better to use WorkSheets() to reference worksheets. To ensure that you always get the correct sheet, regardless of order, use the name:
WorkSheets("Sheet1")
The best method would be to use the CodeName. This is the name of the sheet that the user cannot change. It is found in the sheet list in VBA:
The part before the () is the Codename. So Worksheets("Sheet1") Code Name is Sheet1. Using the code name we reference the sheet simply by typing it:
Sheet1
This cannot be easily changed by the user, as the name of the sheet can. This will always refer to the proper sheet regardless of tab position and name of the sheet.
Next:
Do not use .Activate or .Select They just slow down the code. Just append the ranges with the correct sheet references:
Worksheets("Sheet1").Range("A1")
Or better with the CodeName:
Sheet1.Range("A1")
My question is actually quite simple but I can't find a solution.
I have a lot of sheets with different names that can be modified by the user. I've given to each of those sheets a background name, so for my first two sheets, their names in my VBA project look like this:
The fact is, I want to do a macro to loop through all those particular Sheets (I have 14 of them), and I don't want to Loop through the other ones that I use for different things, like this one:
It is easy to loop through my Sheets using the names that can be modified by the user ("General" et "Heritage" in my example). Nevertheless, I want the user to be able to modify this name whenever he wants, and if he does that, my macros will not recognize the new name of the sheet. It is really important for me that the user doesn't have to push a button or use a different textbox to rename his sheet, I don't want to avoid the problem this way.
What I want is to be able to loop through the background name (S1 and S2 in my example), doing something like that (I know that the following code isn't good, but it is just to give you an example):
Sub Example1()
Dim wksht As Worksheet
For i = 1 To 14
Set wksht = "S" & i
wksht.Cells(1, 1).Value = 1
Next i
End Sub
I know that the following code works for 1 sheet:
Sub Example2()
Dim wksht As Worksheet
Set wksht = S1
wksht.Cells(1, 1).Value = 1
Next i
End Sub
The problem is S1 in my previous code isn't a string, so I can't loop using "S" & i. Is there a solution to my problem ?
You are using the sheet code name, so can do something like this. By the way, this will match S followed by a single digit which may or may not be sufficient for your needs. (By the way, it's 'through', not 'threw'.)
Sub Example1()
Dim wksht As Worksheet
For Each wksht In Worksheets
If wksht.CodeName Like "S#" Then
'do something
End If
Next wksht
End Sub
Based on my research, there does not appear a way to reference sheets based on their codename string, however, you can get the codename as a string from a sheet.
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Dim ws_temp As Worksheet
Dim i As Long
Set wb = ThisWorkbook
For i = 1 To 4
For Each ws_temp In wb.Sheets
If ws_temp.CodeName = "S" & i Then
Set ws = ws_temp
End If
Next
Debug.Print ws.Name & " " & ws.CodeName
Next
End Sub
This code will march through all of the S# sheets in order, and allow you to work with each one as ws.
I'm having a bit of a problem with this VBA code
Sub upONGOING_Train1()
ScreenUpdating = False
'set variables
Dim rFndCell As Range
Dim strData As String
Dim stFnd As String
Dim fCol As Integer
Dim oCol As Integer
Dim SH As Worksheet
Dim WS As Worksheet
Dim strFName As String
Dim objCell As Object
Set WS = ThisWorkbook.Sheets("Trains")
For Each objCell In WS.Range("L3:L100")
oCol = objCell.Column
strFName = WS.Cells(, oCol).Offset(objCell.Row - 1, 0)
On Error GoTo BLANK: 'skip macro if no train
Workbooks.Open Filename:=strFName 'open ongoing report
Set SH = Worksheets("Trains") 'set sheet
stFnd = WS.Cells(, oCol).Offset(objCell.Row - 1, 2).Value 'set connote
With SH
Set rFndCell = .Range("C3:C1100").Find(stFnd, LookIn:=xlValues)
If Not rFndCell Is Nothing Then
fCol = rFndCell.Column
WS.Cells(, oCol).Offset(objCell.Row - 1, 3).Resize(1, 6).Copy
SH.Cells(, fCol).Offset(rFndCell.Row - 1, 10).Resize(1, 6).PasteSpecial xlPasteValues 'paste values in ongoing report if connote found
ActiveWorkbook.Save 'save ongoing report
ActiveWorkbook.Close 'close ongoing report
Else 'Can't find the item
End If
End With
BLANK:
Next objCell
ScreenUpdating = True
End Sub
What I want it to do is - for every row in L3:L100
Open file listed in column "L" (if there or skip line to next one) and go to sheet
Match value from original sheet column "N" to "C3:C1100" in newly opened sheet
Copy columns "O:T" and paste relative to the matching value in the opened sheet(M:R) and save
However when I leave a gap of 2 rows it gives me the error for file not found instead of proceeding to the next loop like it does when there is only 1 row missing.
Seems i can't post images yet.
Also if anyone can point me in a good direction on how to open the sheet in the cell reference only if it is not already open it will usually only have 2 files to use (max of 4 at end of quarter).
Its just too much trouble to click OK on all the windows that pop up when you try to reopen an already open workbook.
If its any help to get your head around it.
I have 2 separate reports for 2 clients(new each quarter so max of 4 sheets at a time) that will already have the names to be searched (2 sheets in each book).
Any help would be greatly appreciated
Thanks heaps
Thanks to those who have put forth suggestions and code.
I'll them out tomorrow and failing that I've just come up with another idea that to re-purpose some other code I have but didn't realize would help.
The code basically copies what I need to a blank tab and deletes rows with a given value - with some formulas to help sort this would give me a block of rows with no breaks all going to the same destination file.
Thus allowing me to run the (a bit more streamlined Thanks everyone) loop over the remaining rows.
On Error GoTo BLANK
Workbooks.Open Filename:=strFName
Change the above into this:
On Error Resume Next
Workbooks.Open Filename:=strFName
If Err.Number <> 0 Then Goto Blank
As to hpw keep the workbook open, you can leave it open (no .close) but then when you want to open it check first if it is open (i.e. using Workbooks("name")), with some error handling using the same mechanism as above, if error exists then the wb is not already open, you open it.
Finally, avoid counting on the Active stuff, such as the ActiveWorkbook`. Instead, make an explicit reference to you wb, i.e.:
Set wb = Workbooks.Open(Filename:=strFName)
Set SH = wb.Worksheets("Trains")
to consider only not blank cells you can use SpecialCells() method of Range object and leave off any On Error GoTo statements, that should be used in very a few limited cases (one of which we'll see in a second)
furthermore you're using some uselessly long winded 'loops' to reference your relevant cells, for instance:
WS.Cells(, oCol).Offset(objCell.Row - 1, 0)
is equivalent to objCell itself!
and there are some more examples of that kind
finally, let's come to the workbooks open/close issue
you could:
use a Dictionary object to store the name of all opened workbooks so as to leave then open throughout your macro and close them all by the end of it
adopt a helper function that tries to set the wanted sheet (i.e. "Trains") in the wanted workbook (i.e. the one whose name is the current objCell value) and return False if not successful
all what above in this refactoring of your code:
Sub upONGOING_Train1bis()
Dim rFndCell As Range
Dim SH As Worksheet
Dim objCell As Range
Dim shtDict As New Scripting.Dictionary '<--| this is the dictionary that will store every opened workbook name as its 'keys'
Dim key As Variant
' Dim dec As String '<--| do you actually need it?
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Trains") '<-- reference your working worksheet
' dec = .Range("L1") '<-- what's this for? in any case take it out of for loops since its value doesn't depend on current loop variables
For Each objCell In .Range("L3:L100").SpecialCells(xlCellTypeConstants) '<--| loop through L3:L100 range not blank cells only
If TrySetWorksheet(objCell.Value, "Trains", SH) Then '<--|Try to set the wanted worksheet in the wanted workbook: if successful it'd retrun 'True' and leave you with 'SH' variable set to the wanted worksheet
shtDict(SH.Parent.Name) = shtDict(SH.Parent.Name) + 1
Set rFndCell = SH.Range("C3:C1100").Find(objCell.Offset(, 2).Value, LookIn:=xlValues, lookAt:=xlWhole) '<--| specify at least 'LookIn' and 'LookAt' parameters
If Not rFndCell Is Nothing Then rFndCell.Offset(, 10).Resize(, 6).Value = objCell.Offset(, 3).Resize(, 6).Value
End If
Next objCell
End With
For Each key In shtDict.Keys '<--|loop through opened workbooks dictionary keys
Workbooks(key).Close True '<--| close workbook whose name corresponds to current dictionary key
Next
Application.ScreenUpdating = True
End Sub
Function TrySetWorksheet(fileName As String, shtname As String, sht As Worksheet) As Boolean
Set sht = Nothing
On Error Resume Next
Set sht = Workbooks(Right(fileName, Len(fileName) - InStrRev(fileName, "\"))).Worksheets(shtname) '<--| try looking for an already open workbook with wanted name and wanted sheet
If sht Is Nothing Then Set sht = Workbooks.Open(fileName:=fileName).Worksheets(shtname) '<--| if not found then try opening the wanted workbook and set the wanted sheet in it
TrySetWorksheet = Not sht Is Nothing '<--| set the return value to the final result of attempts at locating the wanted sheet
End Function
When I create a named range through the Name Manager, I'm given the option of specifying Workbook or [worksheet name] scope. But if then want to change scope, the drop-down is grayed out. Is there a way, in either Name Manager or, preferablly, VBA to change the scope of an existing named range?
For example:
testName refers to 'sheet1'!A1:B2 with scope Workbook. How would I change that to
testName refers to 'sheet1'!A1:B2 with 'sheet1' scope?
I found the solution! Just copy the sheet with your named variables. Then delete the original sheet. The copied sheet will now have the same named variables, but with a local scope (scope= the copied sheet).
However, I don't know how to change from local variables to global..
You can download the free Name Manager addin developed by myself and Jan Karel Pieterse from
http://www.decisionmodels.com/downloads.htm
This enables many name operations that the Excel 2007 Name manager cannot handle, including changing scope of names.
In VBA:
Sub TestName()
Application.Calculation = xlManual
Names("TestName").Delete
Range("Sheet1!$A$1:$B$2").Name = "Sheet1!TestName"
Application.Calculation = xlAutomatic
End Sub
Check out these two subs that reverse each other and flip the scope (worksheet to workbook or reverse) of all named ranges that refer to a range on the active sheet.
Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : RescopeNamedRangesToWorkbook
' Author : JS20'07'11
' Date : 11/18/2013
' Purpose : Rescopes the parent of worksheet scoped named ranges to the active workbook
' for each named range with a scope equal to the active sheet in the active workbook.
'---------------------------------------------------------------------------------------
Public Sub RescopeNamedRangesToWorkbook()
Dim wb As Workbook
Dim ws As Worksheet
Dim objName As Name
Dim sWsName As String
Dim sWbName As String
Dim sRefersTo As String
Dim sObjName As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet
sWsName = ws.Name
sWbName = wb.Name
'Loop through names in worksheet.
For Each objName In ws.Names
'Check name is visble.
If objName.Visible = True Then
'Check name refers to a range on the active sheet.
If InStr(1, objName.RefersTo, sWsName, vbTextCompare) Then
sRefersTo = objName.RefersTo
sObjName = objName.Name
'Check name is scoped to the worksheet.
If objName.Parent.Name <> sWbName Then
'Delete the current name scoped to worksheet replacing with workbook scoped name.
sObjName = Mid(sObjName, InStr(1, sObjName, "!") + 1, Len(sObjName))
objName.Delete
wb.Names.Add Name:=sObjName, RefersTo:=sRefersTo
End If
End If
End If
Next objName
End Sub
'---------------------------------------------------------------------------------------
' Procedure : RescopeNamedRangesToWorksheet
' Author : JS20'07'11
' Date : 11/18/2013
' Purpose : Rescopes each workbook scoped named range to the specific worksheet to
' which the range refers for each named range that refers to the active worksheet.
'---------------------------------------------------------------------------------------
Public Sub RescopeNamedRangesToWorksheet()
Dim wb As Workbook
Dim ws As Worksheet
Dim objName As Name
Dim sWsName As String
Dim sWbName As String
Dim sRefersTo As String
Dim sObjName As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet
sWsName = ws.Name
sWbName = wb.Name
'Loop through names in worksheet.
For Each objName In wb.Names
'Check name is visble.
If objName.Visible = True Then
'Check name refers to a range on the active sheet.
If InStr(1, objName.RefersTo, sWsName, vbTextCompare) Then
sRefersTo = objName.RefersTo
sObjName = objName.Name
'Check name is scoped to the workbook.
If objName.Parent.Name = sWbName Then
'Delete the current name scoped to workbook replacing with worksheet scoped name.
objName.Delete
ws.Names.Add Name:=sObjName, RefersTo:=sRefersTo
End If
End If
End If
Next objName
End Sub
An alternative way is to "hack" the Excel file for 2007 or higher, although it is advisable to take care if you are doing this, and keep a backup of the original:
First save the Excel spreadsheet as an .xlsx or .xlsm file (not binary). rename the file to .zip, then unzip. Go to the xl folder in the zip structure and open workbook.xml in Wordpad or a similar text editor. Named ranges are found in the definedName tags. Local scoping is defined by localSheetId="x" (the sheet IDs can be found by pressing Alt-F11 in Excel, with the spreadsheet open, to get to the VBA window, and then looking at the Project pane). Hidden ranges are defined by hidden="1", so just delete the hidden="1" to unhide, for example.
Now rezip the folder structure, taking care to maintain the integrity of the folder structure, and rename back to .xlsx or .xlsm.
This is probably not the best solution if you need to change the scope of or hide/unhide a large number of defined ranges, though it works fine for making one or two small tweaks.
create the new name from scratch and delete the old one.
These answers were helpful in solving a similar issue while trying to define a named range with Workbook scope. The "ah-HA!" for me is to use the Names Collection which is relative to the whole Workbook! This may be restating the obvious to many, but it wasn't clearly stated in my research, so I share for other's with similar questions.
' Local / Worksheet only scope
Worksheets("Sheet2").Names.Add Name:="a_test_rng1", RefersTo:=Range("A1:A4")
' Global / Workbook scope
ThisWorkbook.Names.Add Name:="a_test_rng2", RefersTo:=Range("B1:b4")
If you look at your list of names when Sheet2 is active, both ranges are there, but switch to any other sheet, and "a_test_rng1" is not present.
Now I can happily generate a named range in my code with what ever scope I deem appropriate. No need mess around with the name manager or a plug in.
Aside, the name manager in Excel Mac 2011 is a mess, but I did discover that while there are no column labels to tell you what you're looking at while viewing your list of named ranges, if there is a sheet listed beside the name, that name is scoped to worksheet / local. See screenshot attached.
Full credit to this article for putting together the pieces.
here's how I promote all worksheet names to global names. YMMV
For Each wsh In ActiveWorkbook.Worksheets
For Each n In wsh.Names
' Get unqualified range name
Dim s As String
s = Split(n.Name, "!")(UBound(Split(n.Name, "!")))
' Add to "Workbook" scope
n.RefersToRange.Name = s
' Remove from "Worksheet" scope
Call n.Delete
Next n
Next wsh
This still needs more refining however works with all simple references, without killing existing local names.
Type GlobalNamesToLocalNames_Type
Name As String
Sheet As String
Ref As String
End Type
Sub GlobalNamesToLocalNames(Optional Void As Variant)
Dim List() As GlobalNamesToLocalNames_Type
Dim Count As Long
Dim Name As Name
Dim Dat() As String
Dim X As Long
' count the size
For Each Name In ActiveWorkbook.Names
Count = Count + 1
Next
ReDim List(Count - 1)
Count = 0
' Collecect all name data
For Each Name In ActiveWorkbook.Names
With List(Count)
' Pick up only the name
If InStr(Name.Name, "!") > 0 Then
Dat = Split(Name.Name, "!")
.Name = Dat(1)
Else
.Name = Name.Name
End If
' pick up the sheet and refer
Dat = Split(Name.RefersTo, "!")
.Sheet = Mid(Dat(0), 2)
.Ref = Dat(1)
' make local sheet name
.Name = .Sheet & "!" & .Name
End With
Count = Count + 1
Next
' Delete all names
For Each Name In ActiveWorkbook.Names
Name.Delete
Next
'rebuild all the names
For X = 0 To Count - 1
With List(X)
If Left(.Ref, 1) <> "#" Then
ActiveWorkbook.Names.Add Name:=.Name, RefersToLocal:="=" & .Sheet & "!" & .Ref
End If
End With
Next
End Sub
For me it works that when I create new Name tag for the same range from the Name Manager it gives me the option to change scope ;) workbook comes as default and can be changed to any of the available sheets.
The code of JS20'07'11 is really incredible simple and direct. One suggestion that I would like to give is to put a exclamation mark in the conditions:
InStr(1, objName.RefersTo, sWsName+"!", vbTextCompare)
Because this will prevent adding a NamedRange in an incorrect Sheet. Eg: If the NamedRange refers to a Sheet named Plan11 and you have another Sheet named Plan1 the code can do some mess when add the ranges if you don't use the exclamation mark.
UPDATE
A correction: It's best to use a regular expression evaluate the name of the Sheet. A simple function that you can use is the following (adapted by http://blog.malcolmp.com/2010/regular-expressions-excel-add-in, enable Microsoft VBScript Regular Expressions 5.5):
Function xMatch(pattern As String, searchText As String, Optional matchIndex As Integer = 1, Optional ignoreCase As Boolean = True) As String
On Error Resume Next
Dim RegEx As New RegExp
RegEx.Global = True
RegEx.MultiLine = True
RegEx.pattern = pattern
RegEx.ignoreCase = ignoreCase
Dim matches As MatchCollection
Set matches = RegEx.Execute(searchText)
Dim i As Integer
i = 1
For Each Match In matches
If i = matchIndex Then
xMatch = Match.Value
End If
i = i + 1
Next
End Function
So, You can use something like that:
xMatch("'?" +sWsName + "'?" + "!", objName.RefersTo, 1) <> ""
instead of
InStr(1, objName.RefersTo, sWsName+"!", vbTextCompare)
This will cover Plan1 and 'Plan1' (when the range refers to more than one cell) variations
TIP: Avoid Sheet names with single quotes ('), :) .
I added some additional lines of code to JS20'07'11's previous Makro to make sure that the name of the sheet's Named Ranges isn't already a name of the workbook's Named Ranges.
Without these lines the already definied workbook scooped Named range is deleted and replaced.
Public Sub RescopeNamedRangesToWorkbookV2()
Dim wb As Workbook
Dim ws As Worksheet
Dim objNameWs As Name
Dim objNameWb As Name
Dim sWsName As String
Dim sWbName As String
Dim sRefersTo As String
Dim sObjName As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet
sWsName = ws.Name
sWbName = wb.Name
'Loop through names in worksheet.
For Each objNameWs In ws.Names
'Check name is visble.
If objNameWs.Visible = True Then
'Check name refers to a range on the active sheet.
If InStr(1, objNameWs.RefersTo, sWsName, vbTextCompare) Then
sRefersTo = objNameWs.RefersTo
sObjName = objNameWs.Name
'Check name is scoped to the worksheet.
If objNameWs.Parent.Name <> sWbName Then
'Delete the current name scoped to worksheet replacing with workbook scoped name.
sObjName = Mid(sObjName, InStr(1, sObjName, "!") + 1, Len(sObjName))
'Check to see if there already is a Named Range with the same Name with the full workbook scope.
For Each objNameWb In wb.Names
If sObjName = objNameWb.Name Then
MsgBox "There is already a Named range with ""Workbook scope"" named """ + sObjName + """. Change either Named Range names or delete one before running this Macro."
Exit Sub
End If
Next objNameWb
objNameWs.Delete
wb.Names.Add Name:=sObjName, RefersTo:=sRefersTo
End If
End If
End If
Next objNameWs
End Sub
Found this at theexceladdict.com
Select the Named range on your worksheet whose scope you want to change;
Open the Name Manager (Formulas tab) and select the name;
Click Delete and OK;
Click New… and type in the original name back in the Name field;
Make sure Scope is set to Workbook and click Close.