Hide/Unhide Macro bug

D

Dave

I'd bet this is a simple error and I'm just not seeing the bug but, if
anyone out there can help it'd be really appreciated!

Here it is:
I have a macro that essentially hides rows given that a certain cell
in a declared array has a zero value. Also, the macro is able to
decide if the current state of the spreadsheet is in the "hidden" or
"unhidden" state and take the appropriate action to reverse it's
current state by clicking an ActiveX command button. I'm getting a
"subscript out of range" error. Below is the code. The error is
highlighted with "%%%"

Dim sHideStatusCur, sSheetName


Private Sub HideButtonEstimate2_Click()

'########################################################
'## CELLS LISTED HERE WILL BE EVALUATED TO HIDE THE ROW
'##
'## If cell listed has a value of 0 then entire row cell is contained
'## in will be hidden. If a row has been hidden, pressing the button
'## again will unhide all rows in the displayed sheet.
'##
'## example: arrEvalRows("C3", "D4")
'## in the above statement, if C3 = 0, Row 3 will be hidden on button
press
'## in the above statement, if D4 = 0, Row 4 will be hidden on button
press
'##
'## notes: be sure to use quotes to encapsulate row values.
'##
'########################################################




Dim i, myCell, sHideStatusOld, sHideStatusCell
sSheetName = "Estimate2"
sHideStatusCell = "E29"
arrEvalRows = Array("E9", "E10", "E11", "E12", "E13", "E14", "E15",
"E21", "E22", "E23", "E24", "E25", "E26", "E27", "E28", "E29", "E30",
"E31", "E32", "E33", "E34", "E35", "E36", "E37", "E38", "E39", "E40",
"E41", "E42", "E45", "E46", "E47", "E54", "E55", "E56", "E57", "E58",
"E59", "E60", "E61", "E63", "E64", "E65", "E66", "E69", "E70", "E71",
"E72", "E73", "E74", "E75", "E76", "E79", "E80", "E81")



'## Determine hide/unhide toggle
sHideStatusOld = Worksheets("Calculation
Tab").Range(sHideStatusCell).Value
If Len(sHideStatusOld) < 1 Then
Worksheets("Calculation Tab").Range(sHideStatusCell).Value = "HID"
sHideStatusCur = "HID"
ElseIf UCase(sHideStatusOld) = "HID" Then
Worksheets("Calculation Tab").Range(sHideStatusCell).Value =
"UNHID"
sHideStatusCur = "UNHID"
ElseIf UCase(sHideStatusOld) = "UNHID" Then
Worksheets("Calculation Tab").Range(sHideStatusCell).Value = "HID"
sHideStatusCur = "HID"
End If

'HIDE ROWS
For i = 0 To UBound(arrEvalRows)
Call HideRows(arrEvalRows(i), sSheetName)
Next

'## Custom function to evaluate Lycra column
'## 12/30/2002,
'## incorrect specfication.
'## functionality removed, added to standard hide function.
'Call HideRowsOR("E58", "F58", sSheetName)

End Sub

Function HideRows(myCell, ByVal sSheetName)
Dim myRow
Dim bHide

myRow = Right(myCell, (Len(myCell) - 1))
'MsgBox (myCell & " - " & myRow)

bHide = False 'Hid this round, or no?
%%% If Worksheets(sSheetName).Range(myCell).Value = 0 Then %%%
If (Worksheets(sSheetName).Rows(myRow).Hidden = False) And
(sHideStatusCur = "HID") Then bHide = True
Worksheets(sSheetName).Rows(myRow).Hidden = True
End If
'UNHIDE if hidden
If (Worksheets(sSheetName).Rows(myRow).Hidden = True) And (bHide =
False) And (sHideStatusCur = "UNHID") Then
Worksheets(sSheetName).Rows(myRow).Hidden = False
End If

End Function


Function HideRowsOR(myCell, myCell2, ByVal sSheetName)
Dim myRow
Dim bHide


myRow = Right(myCell, (Len(myCell) - 1))
'MsgBox (myCell & " - " & myRow)

bHide = False 'Hid this round, or no?
bPreventHide = False
If (Worksheets(sSheetName).Range(myCell).Value > 0) Or
(Worksheets(sSheetName).Range(myCell2).Value > 0) Then bPreventHide =
True

If (Worksheets(sSheetName).Range(myCell).Value = 0) Or
(Worksheets(sSheetName).Range(myCell2).Value = 0) Then
If Worksheets(sSheetName).Rows(myRow).Hidden = False Then bHide =
True
If bPreventHide = False And sHideStatusCur = "HID" Then
Worksheets(sSheetName).Rows(myRow).Hidden = True
Else
End If

End If
'UNHIDE if hidden
If Worksheets(sSheetName).Rows(myRow).Hidden = True And bHide = False
And bPreventHide = False And sHideStatusCur = "UNHID" Then
Worksheets(sSheetName).Rows(myRow).Hidden = False
End If
End Function

Function ResetRows(myCell, ByVal sSheetName)
Dim myRow
Dim bHide

myRow = Right(myCell, (Len(myCell) - 1))

'MsgBox ("sSheetName = " & sSheetName & vbCLRF & "myRow = " & myRow)
Worksheets(sSheetName).Rows(myRow).Hidden = False

End Function
 
T

Tom Ogilvy

If Worksheets(sSheetName).Range(myCell).Value = 0 Then

Only thing that would cause a subscript out of range error in that line
would be is sSheetName does not contain a valid sheetname.

You can check it here

Dim sh as Worksheet
On Error Resume Next
set sh = Worksheets(sSheetName)
On Error goto 0
if sh is nothing then
msgbox "Problem: value of sSheetname ( ->" & sSheetName & _
"<- ) is not valid"
End if
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top