Hide multiple rows when particular cell is zero

B

blommerse

Hi All,

Can anyone tell me how I can hide multiple rows when a particular cell
is zero?
It has to go automaticly, so no buttons...

When D37=0, hide rows 37-48
When D49=0, hide rows 49-58
When D59=0, hide rows 59-68
When D69=0, hide rows 69-78
When D79=0, hide rows 79-88
etcetera.

How can help me with this macro??
Thanks in advanced.

Best regards,
BL
 
J

Jon von der Heyden

Hi,

What should happen if e.g. D38 = 0?

Maybe this applied to the desired sheet:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim a, rng As Range

Set rng = Range("D37:D1000")

For Each a In rng

If a.Value = 0 And a <> "" Then
Range(a.Row & ":" & a.Offset(11, 0).Row).EntireRow.Hidden = True
End If

Next a

End Sub

Change rng to suite.
 
K

Ken Johnson

Hi BL,
This seems to work...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCheck As Range
Dim lLastRow As Long
Dim rngCell As Range
Dim I As Long
Application.EnableEvents = False
On Error GoTo ERROR_HANDLER
lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D37"
For I = 49 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & I
Next I
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 37
Range(Cells(37, 1), Cells(48, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 9, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select
Next rngCell
Application.EnableEvents = True
Exit Sub
ERROR_HANDLER: Application.EnableEvents = True
End Sub

It's triggered whenever a cell on that sheet changes, so the zero
values governing the row hiding can be determined by a formula in those
D cells or directly entered into those D cells.

If you require that the code be triggered by any workbook calculation
then you could try...

Private Sub Worksheet_Calculate()
Application.EnableEvents = False
On Error GoTo ERROR_HANDLER
Dim rngCheck As Range
Dim lLastRow As Long
Dim rngCell As Range
Dim I As Long
lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D37"
For I = 49 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & I
Next I
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 37
Range(Cells(37, 1), Cells(48, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 9, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select
Next rngCell
Application.EnableEvents = True
Exit Sub
ERROR_HANDLER: Application.EnableEvents = True
End Sub

The trouble here though is if you ever need to manually unhide the
hidden rows to get to a hidden cell to edit its value, the automatic
code just rehides any rows you try to unhide, so you would need to go
into the VBA editor and disable events in the immediate window.

Ken Johnson
 
B

blommerse

Hi Ken,

Thanks, that works perfect!
I have another problem, maybe you can help me also to solve this:
In cell B7 people can fill in 1-10 with validation.
Now what I want is when people fill in 1 only colomn E and F apear.
When people fill in 2 in cell B7colomn E, F, G, H apear
When peple fill in 3 in cell B7 colomn E, F, G, H, I, J apear.
Etcetera.

Colomn A, B, C, D is fixed.
This is not in the same sheet as other one.

Thanks in advanced.
Best Regards,
 
K

Ken Johnson

Hi Ken,

Thanks, that works perfect!
I have another problem, maybe you can help me also to solve this:
In cell B7 people can fill in 1-10 with validation.
Now what I want is when people fill in 1 only colomn E and F apear.
When people fill in 2 in cell B7colomn E, F, G, H apear
When peple fill in 3 in cell B7 colomn E, F, G, H, I, J apear.
Etcetera.

Colomn A, B, C, D is fixed.
This is not in the same sheet as other one.

Thanks in advanced.
Best Regards,
Click to expand...

Hi BL,

Try this...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B7")) Is Nothing Then
Application.ScreenUpdating = False
Range(Cells(1, 5), _
Cells(1, Columns.Count)).EntireColumn.Hidden = False
Range(Cells(1, Range("B7").Value * 2 + 5), _
Cells(1, Columns.Count)).EntireColumn.Hidden = True
End If
End Sub

Ken Johnson
 
B

blommerse

Great Ken,

My last question (I hope):
In your code it said:

lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D37"
For I = 49 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & I
Next I
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 37
Range(Cells(37, 1), Cells(48, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 9, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select

How can I change the code when lookup value changes.
For example when cell D49 changes in D51
And D59 changes in D65.

Thanks for all your help.
Greets
 
B

blommerse

Great Ken,

My last question (I hope):
In your code it said:

lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D37"
For I = 49 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & I
Next I
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 37
Range(Cells(37, 1), Cells(48, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 9, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select

How can I change the code when lookup value changes.
For example when cell D49 changes in D51
And D59 changes in D65.

Thanks for all your help.
Greets
 
B

blommerse

Ken Johnson schreef:
Hi BL,

Try this...

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B7")) Is Nothing Then
Application.ScreenUpdating = False
Range(Cells(1, 5), _
Cells(1, Columns.Count)).EntireColumn.Hidden = False
Range(Cells(1, Range("B7").Value * 2 + 5), _
Cells(1, Columns.Count)).EntireColumn.Hidden = True
End If
End Sub

Ken Johnson
Click to expand...
 
B

blommerse

Great Ken,

My last question (I hope):
In your code it said:

lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D37"
For I = 49 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & I
Next I
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 37
Range(Cells(37, 1), Cells(48, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 9, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select

How can I change the code when lookup value changes.
For example when cell D49 changes in D51
And D59 changes in D65.

Thanks for all your help.
Greets
 
K

Ken Johnson

Hi BL,
How can I change the code when lookup value changes.
For example when cell D49 changes in D51
And D59 changes in D65.
Click to expand...

I'm having trouble understanding what you are wanting here.
Could you supply some more information to help me understand your
needs?

Ken Johnson
 
B

blommerse

This is what the code do first:

When D37=0, hide rows 37-48
When D49=0, hide rows 49-58
When D59=0, hide rows 59-68
etcetera.

Now I add some rows so the cell which change in 0 (zero) is changed.
So this is what is should do now:

When D43=0, hide rows 43-46
When D57=0, hide rows 57-70
When D71=0, hide rows 71-84
When D85=0, hide rows 85-94
When D95=0, hide rows 95-104
etc.
Till cell D265.

This is what I have:

strCheckAddress = "D43"
For I = 85 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & I
Next I
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 43
Range(Cells(43, 1), Cells(85, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 9, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select

Regards,
 
K

Ken Johnson

Hi BL,

I hope that those changes in row numbers is just a permanent change in
the structure of your worksheet, and that you are not wanting the code
to first work according to your original rules and then start working
according to your new rules. I don't know how the code could be set up
to work one way then change to a different way after you add some extra
rows.

If I am correct in assuming that the change in rows is just a permanent
change you have made to your sheet's structure and that you are simply
wanting the code to work in accordance with that new structure, then
try...


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCheck As Range
Dim lLastRow As Long
Dim rngCell As Range
Dim i As Long
Application.EnableEvents = False
On Error GoTo ERROR_HANDLER
lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D43,D57,D71"
For i = 85 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & i
Next i
MsgBox strCheckAddress
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 43
Range(Cells(43, 1), Cells(46, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case 57, 71
Range(Cells(rngCell.Row, 1), Cells(rngCell.Row + 13,
1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), Cells(rngCell.Row + 9,
1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select
Next rngCell
Application.EnableEvents = True
Exit Sub
ERROR_HANDLER: Application.EnableEvents = True
End Sub

I'm keeping my fingers crossed:)

Ken Johnson
 
K

Ken Johnson

Oops!
Sorry about that MsgBox I forgot to delete. I was using it to check the
progress of the code and neglected to remove it before replying.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCheck As Range
Dim lLastRow As Long
Dim rngCell As Range
Dim i As Long
Application.EnableEvents = False
On Error GoTo ERROR_HANDLER
lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D43,D57,D71"
For i = 85 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & i
Next i
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 43
Range(Cells(43, 1), Cells(46, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case 57, 71
Range(Cells(rngCell.Row, 1), Cells(rngCell.Row + 13,
1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), Cells(rngCell.Row + 9,
1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select
Next rngCell
Application.EnableEvents = True
Exit Sub
ERROR_HANDLER: Application.EnableEvents = True
End Sub

Ken Johnson
 
K

Ken Johnson

I'm getting careless with the line breaks too!


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCheck As Range
Dim lLastRow As Long
Dim rngCell As Range
Dim i As Long
Application.EnableEvents = False
On Error GoTo ERROR_HANDLER
lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D43,D57,D71"
For i = 85 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & i
Next i
MsgBox strCheckAddress
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 43
Range(Cells(43, 1), _
Cells(46, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case 57, 71
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 13, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 9, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select
Next rngCell
Application.EnableEvents = True
Exit Sub
ERROR_HANDLER: Application.EnableEvents = True
End Sub

Hopefully you can cope with my blunders.

Ken Johnson
 
B

blommerse

Great, Funny, it works!!! Thanks.
Only I get a message that I'm sure I want to check these cells, you
have to click on OK.
Also not so funny is that it's calculating every time you change
anything.
Maybe you know an anser for it.
Otherwise I want to thank you very much for your time.

Regards,
Berry
 
K

Ken Johnson

Great, Funny, it works!!! Thanks.
Only I get a message that I'm sure I want to check these cells, you
have to click on OK.
Also not so funny is that it's calculating every time you change
anything.
Maybe you know an anser for it.
Otherwise I want to thank you very much for your time.

Regards,
Berry
Click to expand...

Hi Berry,

It's just past midnight here and I'm making quite a few mistakes.

I'll try again, this time, no MsgBox and no broken code lines (Google
breaks the code lines if I'm not careful)

Two replies ago I took out the MsgBox, one reply ago I repaired the
broken code lines but carelessly left the MsgBox in:-\

With the MsgBox removed everything should work satisfactorily...


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngCheck As Range
Dim lLastRow As Long
Dim rngCell As Range
Dim I As Long
Application.EnableEvents = False
On Error GoTo ERROR_HANDLER
lLastRow = Range("D" & Range("D:D").Rows.Count).End(xlUp).Row
Dim strCheckAddress As String
strCheckAddress = "D43,D57,D71"
For I = 85 To lLastRow Step 10
strCheckAddress = strCheckAddress & ", D" & I
Next I
Set rngCheck = Range(strCheckAddress)
For Each rngCell In rngCheck
Select Case rngCell.Row
Case 43
Range(Cells(43, 1), _
Cells(46, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case 57, 71
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 13, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
Case Else
Range(Cells(rngCell.Row, 1), _
Cells(rngCell.Row + 9, 1)).EntireRow.Hidden = _
IIf(rngCell.Value = 0, True, False)
End Select
Next rngCell
Application.EnableEvents = True
Exit Sub
ERROR_HANDLER: Application.EnableEvents = True
End Sub

Ken Johnson
 
B

blommerse

Hi Berry,

It's just past midnight here and I'm making quite a few mistakes.

I'll try again, this time, no MsgBox and no broken code lines (Google
breaks the code lines if I'm not careful)

Two replies ago I took out the MsgBox, one reply ago I repaired the
broken code lines but carelessly left the MsgBox in:-\

With the MsgBox removed everything should work satisfactorily...
Click to expand...
Hi Ken,

Thank you very very much for all your help.
It works perfect with this code.
Thanks again.

Best Regards, Berry
 

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

Similar Threads

Code to hide rows if cell in another WS is ="No" 11
Hide Rows when 3 conditions are met 4
Hide blank rows - what is wrong with this code ??? 3
hide zero rows / shadwe every other visible 1
How to hide rows in a Workbook with multiple sheets with zero valu 6
how can I hide rows when a field is blank? 13
Macro to hide rows based on a zero value in a particular cell 2
problem with =isnumber(match(right(... 17

Top