|
find workbook names that are in sheet
Needed a function that finds the Workbook level names
that are in a specified sheet and have put something together, but have a feeling that there is a better (less code) way to handle this: Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then With oSheet Set rngSheet = .Range(.Cells(1), .Cells(.Rows.Count, Columns.Count)) End With Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function Any suggestions to improve on this? RBS |
find workbook names that are in sheet
Before I go a whole pile further can you confirm something for me. You only
want workbook level names and not sheet level names included. The reason that I ask is that your code is including the sheet level names... Try this... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set rngSheet = oSheet.Cells Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If na.Parent.Name = oSheet.Name Then MsgBox na.Name & " is Local" If na.Parent.Name = ActiveWorkbook.Name Then MsgBox na.Name & " is Global" If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Needed a function that finds the Workbook level names that are in a specified sheet and have put something together, but have a feeling that there is a better (less code) way to handle this: Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then With oSheet Set rngSheet = .Range(.Cells(1), .Cells(.Rows.Count, Columns.Count)) End With Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function Any suggestions to improve on this? RBS |
find workbook names that are in sheet
Yes, only workbook level names.
In this application I just never use sheet level names, so I don't sheet level names will appear in these workbooks. Will check though and thanks for the tip about Parent.Name. RBS "Jim Thomlinson" wrote in message ... Before I go a whole pile further can you confirm something for me. You only want workbook level names and not sheet level names included. The reason that I ask is that your code is including the sheet level names... Try this... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set rngSheet = oSheet.Cells Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If na.Parent.Name = oSheet.Name Then MsgBox na.Name & " is Local" If na.Parent.Name = ActiveWorkbook.Name Then MsgBox na.Name & " is Global" If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Needed a function that finds the Workbook level names that are in a specified sheet and have put something together, but have a feeling that there is a better (less code) way to handle this: Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then With oSheet Set rngSheet = .Range(.Cells(1), .Cells(.Rows.Count, Columns.Count)) End With Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function Any suggestions to improve on this? RBS |
find workbook names that are in sheet
In that case you are looking for names where the parent of the name is the
workbook and the parent of the refered to range is the sheet. So something like this should do... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set collNames = New Collection For Each na In ActiveWorkbook.Names If na.RefersToRange.Parent.Name = oSheet.Name And _ na.Parent.Name = ActiveWorkbook.Name Then collNames.Add na.Name i = i + 1 End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Yes, only workbook level names. In this application I just never use sheet level names, so I don't sheet level names will appear in these workbooks. Will check though and thanks for the tip about Parent.Name. RBS "Jim Thomlinson" wrote in message ... Before I go a whole pile further can you confirm something for me. You only want workbook level names and not sheet level names included. The reason that I ask is that your code is including the sheet level names... Try this... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set rngSheet = oSheet.Cells Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If na.Parent.Name = oSheet.Name Then MsgBox na.Name & " is Local" If na.Parent.Name = ActiveWorkbook.Name Then MsgBox na.Name & " is Global" If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Needed a function that finds the Workbook level names that are in a specified sheet and have put something together, but have a feeling that there is a better (less code) way to handle this: Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then With oSheet Set rngSheet = .Range(.Cells(1), .Cells(.Rows.Count, Columns.Count)) End With Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function Any suggestions to improve on this? RBS |
find workbook names that are in sheet
Another one -
Sub test() Dim arr MsgBox GetNames(ActiveSheet, arr) End Sub Function GetNames(oWsht As Worksheet, arr) Dim i As Long Dim nm As Name Dim ws As Worksheet ReDim arr(1 To oWsht.Parent.Names.Count) On Error Resume Next 'RefersToRange error if not be a range name For Each nm In oWsht.Parent.Names If InStr(nm.Name, "!") = 0 Then ' not local Set ws = nm.RefersToRange.Parent If Not ws Is Nothing Then If ws Is oWsht Then i = i + 1 arr(i) = nm.Name Set ws = Nothing End If End If End If Next If i Then ReDim Preserve arr(1 To i) End If GetNames = i End Function Regards, Peter T "RB Smissaert" wrote in message ... Needed a function that finds the Workbook level names that are in a specified sheet and have put something together, but have a feeling that there is a better (less code) way to handle this: |
find workbook names that are in sheet
Thanks Jim and Peter.
This looks a lot better than using Intersect. Will do a bit of testing and go with the fastest. RBS "Jim Thomlinson" wrote in message ... In that case you are looking for names where the parent of the name is the workbook and the parent of the refered to range is the sheet. So something like this should do... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set collNames = New Collection For Each na In ActiveWorkbook.Names If na.RefersToRange.Parent.Name = oSheet.Name And _ na.Parent.Name = ActiveWorkbook.Name Then collNames.Add na.Name i = i + 1 End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Yes, only workbook level names. In this application I just never use sheet level names, so I don't sheet level names will appear in these workbooks. Will check though and thanks for the tip about Parent.Name. RBS "Jim Thomlinson" wrote in message ... Before I go a whole pile further can you confirm something for me. You only want workbook level names and not sheet level names included. The reason that I ask is that your code is including the sheet level names... Try this... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set rngSheet = oSheet.Cells Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If na.Parent.Name = oSheet.Name Then MsgBox na.Name & " is Local" If na.Parent.Name = ActiveWorkbook.Name Then MsgBox na.Name & " is Global" If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Needed a function that finds the Workbook level names that are in a specified sheet and have put something together, but have a feeling that there is a better (less code) way to handle this: Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then With oSheet Set rngSheet = .Range(.Cells(1), .Cells(.Rows.Count, Columns.Count)) End With Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function Any suggestions to improve on this? RBS |
find workbook names that are in sheet
"RB Smissaert" wrote in message
and go with the fastest. Typical RBS <g Peter T |
find workbook names that are in sheet
Go with Peter's as it handles named ranges that are actually named formulas.
The code I posted will die an untimely death if it encounters a named formula... -- HTH... Jim Thomlinson "RB Smissaert" wrote: Thanks Jim and Peter. This looks a lot better than using Intersect. Will do a bit of testing and go with the fastest. RBS "Jim Thomlinson" wrote in message ... In that case you are looking for names where the parent of the name is the workbook and the parent of the refered to range is the sheet. So something like this should do... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set collNames = New Collection For Each na In ActiveWorkbook.Names If na.RefersToRange.Parent.Name = oSheet.Name And _ na.Parent.Name = ActiveWorkbook.Name Then collNames.Add na.Name i = i + 1 End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Yes, only workbook level names. In this application I just never use sheet level names, so I don't sheet level names will appear in these workbooks. Will check though and thanks for the tip about Parent.Name. RBS "Jim Thomlinson" wrote in message ... Before I go a whole pile further can you confirm something for me. You only want workbook level names and not sheet level names included. The reason that I ask is that your code is including the sheet level names... Try this... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set rngSheet = oSheet.Cells Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If na.Parent.Name = oSheet.Name Then MsgBox na.Name & " is Local" If na.Parent.Name = ActiveWorkbook.Name Then MsgBox na.Name & " is Global" If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Needed a function that finds the Workbook level names that are in a specified sheet and have put something together, but have a feeling that there is a better (less code) way to handle this: Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then With oSheet Set rngSheet = .Range(.Cells(1), .Cells(.Rows.Count, Columns.Count)) End With Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function Any suggestions to improve on this? RBS |
find workbook names that are in sheet
Yes, I know. Might as well.
Actually as it turns out your code is about 30% faster (even after doing away with the collection in Jim's code), so will go with that one. RBS "Peter T" <peter_t@discussions wrote in message ... "RB Smissaert" wrote in message and go with the fastest. Typical RBS <g Peter T |
find workbook names that are in sheet
Will do and thanks for the trouble taken.
As posted, Peter's code turns out to be quite a bit faster as well. RBS "Jim Thomlinson" wrote in message ... Go with Peter's as it handles named ranges that are actually named formulas. The code I posted will die an untimely death if it encounters a named formula... -- HTH... Jim Thomlinson "RB Smissaert" wrote: Thanks Jim and Peter. This looks a lot better than using Intersect. Will do a bit of testing and go with the fastest. RBS "Jim Thomlinson" wrote in message ... In that case you are looking for names where the parent of the name is the workbook and the parent of the refered to range is the sheet. So something like this should do... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set collNames = New Collection For Each na In ActiveWorkbook.Names If na.RefersToRange.Parent.Name = oSheet.Name And _ na.Parent.Name = ActiveWorkbook.Name Then collNames.Add na.Name i = i + 1 End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Yes, only workbook level names. In this application I just never use sheet level names, so I don't sheet level names will appear in these workbooks. Will check though and thanks for the tip about Parent.Name. RBS "Jim Thomlinson" wrote in message ... Before I go a whole pile further can you confirm something for me. You only want workbook level names and not sheet level names included. The reason that I ask is that your code is including the sheet level names... Try this... Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then Set rngSheet = oSheet.Cells Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If na.Parent.Name = oSheet.Name Then MsgBox na.Name & " is Local" If na.Parent.Name = ActiveWorkbook.Name Then MsgBox na.Name & " is Global" If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function -- HTH... Jim Thomlinson "RB Smissaert" wrote: Needed a function that finds the Workbook level names that are in a specified sheet and have put something together, but have a feeling that there is a better (less code) way to handle this: Function GetSheetNamedRanges(oSheet As Worksheet) As Variant 'this picks up workbook names that are in the specified sheet 'will need to test for no names found in specified sheet by doing: 'If IsArray(arr) Then '----------------------------------------------------------------- Dim i As Long Dim na As Name Dim rngSheet As Range Dim collNames As Collection Dim arrNames If ActiveWorkbook.Names.Count 0 Then With oSheet Set rngSheet = .Range(.Cells(1), .Cells(.Rows.Count, Columns.Count)) End With Set collNames = New Collection On Error Resume Next For Each na In ActiveWorkbook.Names If Not Application.Intersect(rngSheet, Range(na.Name)) Is Nothing Then If Err.Number = 0 Then collNames.Add na.Name i = i + 1 Else Err.Clear End If End If Next na If i 0 Then ReDim arrNames(1 To i) For i = 1 To i arrNames(i) = collNames(i) Next GetSheetNamedRanges = arrNames End If End If End Function Any suggestions to improve on this? RBS |
| All times are GMT +1. The time now is 02:00 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com