PDA

View Full Version : How to pass the active workbook to a function, getting subscript out of range error



karenk
03-09-2012, 09:10 AM
Hi

I am creating 3 worksheets in a workbook from Access VBA, copying Access data on sheets 2 & 3, grouping values, totalling and defining named ranges for the totals, all in VBA. I use these ranges to summarize on Sheet (1) but sometimes certain ranges don't get made as the data value does not occur. My summary forumlas add ranges together but fail if a range did not get created

I have been trying to employ the code found in kb article below (link not allowed, my first post) to test for range first so I can adjust summary formula .vbaexpress.com/kb/getarticle.php?kb_id=729 (code pasted below also)

However the code fails on the Workbook method, saying "subscript out of range"

I call it thus

With objActiveWkb

If NamedRangeExists("MyRange", .Name) Then curBP = .Worksheets(2).Range("MyRange")

and the correct name (e.g. "book8") appears to passed to function when I check

"With Workbooks(wbName)" < mouseover shows wbName = 'book8'

If I place the for loop from the function in my calling routine it works but that is cumbersome as I must test for several ranges.

Thanks in advance for any advice or suggested approachs.
Karen

Function NamedRangeExists(strName As String, _
Optional wbName As String) As Boolean
'Declare variables
Dim rngTest As Range, i As Long

'Set workbook name if not set in function, as default/activebook
If wbName = vbNullString Then wbName = ActiveWorkbook.Name

With Workbooks(wbName)
On Error Resume Next

'Loop through all sheets in workbook. In VBA, you MUST specify
' the worksheet name which the named range is found on. Using
' Named Ranges in worksheet functions DO work across sheets
' without explicit reference.
For i = 1 To .Sheets.Count Step 1

'Try to set our variable as the named range.
Set rngTest = .Sheets(i).Range(strName) 'If there is no error then the name exists.
If Err = 0 Then

'Set the function to TRUE & exit
NamedRangeExists = True
Exit Function
Else
'Clear the error
Err.Clear

End If

Next i
End With
End Function