Passing references

[Geoff]

Hi
I am getting 'Subscript out of range' errors with this code.
The project code is to enable me to create new wbooks from each wsheet of
the current wbook. To do this I read the tab names of a wbook as it is
opened. The number of tabs can differ and their names need not be the
standard Sheet1, Sheet2 etc. When required, a procedure is run to determine
the last data row and cell of a wsheet. It is the reference I use that is
creating problems and while it seems to be ok most of the time, it throws an
error if it does not recognise the tab name.

I would appreciate any guidance on this. Hope it makes sense.

Geoff

Code:
On wbook opening:

Dim tabnames() As String
Dim tabname As Variant '''out of desperation

Sub GetTabNames()
ReDim tabnames(1 To ActiveWorkbook.Sheets.Count)
For i = 1 To ActiveWorkbook.Sheets.Count
tabnames(i) = ActiveWorkbook.Sheets(i).Name
Next
End Sub

Then when selecting a chkbox on a form, ask if the tab exists with:
Sub DoesTabExist()
'''test chkbox selection
tab1 = 0
tab2 = 0
tab3 = 0
tabSheetName = 0

For Each tabname In tabnames
If Right(frmBookMaker.ActiveControl.Name, 6) = tabname And LCase(tabname)
= "sheet1" Then
tab1 = 1
Exit For
ElseIf Right(frmBookMaker.ActiveControl.Name, 6) = tabname And
LCase(tabname) = "sheet2" Then
tab2 = 1
Exit For
ElseIf Right(frmBookMaker.ActiveControl.Name, 6) = tabname And
LCase(tabname) = "sheet3" Then
tab3 = 1
Exit For
ElseIf Not frmBookMaker.txtSheetName.Text = "" And
LCase(frmBookMaker.txtSheetName.Text) = LCase(tabname) Then
tabSheetName = 1
End If
Next
End Sub

Then determine if the word xxx exists and other parameters on the wsheet in
question by calling the following sub using - this is where it will error
sometimes

FindxxxCol "Sheet1" '''''''
If foundCol = "" And locatedCol = 0 Then MsgBox "'xxx' does not exist on
this sheet"

Sub FindxxxCol(wsh As String)
With Sheets(wsh) '''''''''' Errors with Subscript out of range
'''clear any old values
foundCol = ""
locatedCol = 0
realLastRow = 0
realLastColumn = 0

'''get real last row and column of data
On Error Resume Next

realLastRow = .Cells.Find("*", .Range("A1"), , , xlByRows, xlPrevious).Row
realLastColumn = .Cells.Find("*", .Range("A1"), , , xlByColumns,
xlPrevious).Column

'''try to find whole Fax on Row 1
foundCol = Split(.Rows(1).Find("xxx", , , xlWhole).Address, "$")(1)

'''if not there look for part xxx on row 1
If foundCol = "" Then foundFax = Split(.Rows(1).Find("xxx", , ,
xlPart).Address, "$")(1)

'''if not there look for whole xxx in rest of data
If foundCol = "" And realLastRow > 1 Then
Set tbl = .Range(.Cells(2, 1), .Cells(realLastRow, realLastColumn))
locatedCol = tbl.Find("xxx", , , xlWhole).Row
End If
On Error GoTo 0
End With
End Sub

 

[Geoff]

I think I have sorted this by using Name when calling the sub as follows

FindxxxCol Sheets(1).Name FindxxxCol Sheets(2).Name etc etc

all seems ok right now

Geoff