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