|
Hide/Unhide Macro bug
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 |
Hide/Unhide Macro bug
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 -- Regards, Tom Ogilvy "Dave" wrote in message om... 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 |
| All times are GMT +1. The time now is 03:06 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com