Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default 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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,939
Default 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


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default 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



  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,939
Default 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




  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default 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







  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,600
Default find workbook names that are in sheet

"RB Smissaert" wrote in message

and go with the fastest.


Typical RBS <g

Peter T


  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,939
Default 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






  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,600
Default 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:



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
sheet names displayed in first workbook sheet help Dingy101 Excel Programming 9 December 5th 09 12:01 PM
Find and Replace Sheet names FARAZ QURESHI Excel Discussion (Misc queries) 2 February 23rd 09 01:40 AM
Using Sheet names & Workbook names in VBA coding Colin Foster[_5_] Excel Programming 5 July 7th 06 07:04 PM
Run macro to find names on seperate workbook, then add info from t Tim Excel Discussion (Misc queries) 1 March 22nd 06 03:47 PM
how do I find names in a workbook full of names aj Excel Discussion (Misc queries) 1 January 19th 06 09:01 PM


All times are GMT +1. The time now is 06:52 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"