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

"Geoff" wrote:

> 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