Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#5
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#6
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
"RB Smissaert" wrote in message
and go with the fastest. Typical RBS <g Peter T |
#7
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#8
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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: |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
sheet names displayed in first workbook sheet help | Excel Programming | |||
Find and Replace Sheet names | Excel Discussion (Misc queries) | |||
Using Sheet names & Workbook names in VBA coding | Excel Programming | |||
Run macro to find names on seperate workbook, then add info from t | Excel Discussion (Misc queries) | |||
how do I find names in a workbook full of names | Excel Discussion (Misc queries) |