Solved: VBA hide columns or rows based on certain criteria

[thebazman]

hi all,

im hoping someone will be able to help with this as i dont have the knowledge to write it myself, and it would make a huge difference.

ive been making an instalment spreadsheet for our team at work,
(attached)

it contains 2 sheets a data and a print sheet, the print sheet copies certain cells from the data sheet formatted and with less info for when we need hard copies.

i need to 3 things, on the data sheet i need to hide entire columns based on the criteria of cell C9 (will have a value of 0 - 12)

im currently using this code, it works but im sure its probably an inefficient way


Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("C9") Then
Select Case UCase(Target.Value)
Case "0"
Range("H:AQ").EntireColumn.Hidden = True

Case "1"
Range("H:J").EntireColumn.Hidden = False
Range("K:AQ").EntireColumn.Hidden = True

Case "2"
Range("H:M").EntireColumn.Hidden = False
Range("N:AQ").EntireColumn.Hidden = True

Case "3"
Range("H:P").EntireColumn.Hidden = False
Range("Q:AQ").EntireColumn.Hidden = True

Case "4"
Range("H:S").EntireColumn.Hidden = False
Range("T:AQ").EntireColumn.Hidden = True

Case "5"
Range("H:V").EntireColumn.Hidden = False
Range("W:AQ").EntireColumn.Hidden = True

Case "6"
Range("H:Y").EntireColumn.Hidden = False
Range("Z:AQ").EntireColumn.Hidden = True

Case "7"
Range("H:AB").EntireColumn.Hidden = False
Range("AC:AQ").EntireColumn.Hidden = True

Case "8"
Range("H:AE").EntireColumn.Hidden = False
Range("AF:AQ").EntireColumn.Hidden = True

Case "9"
Range("H:AH").EntireColumn.Hidden = False
Range("AI:AQ").EntireColumn.Hidden = True

Case "10"
Range("H:AK").EntireColumn.Hidden = False
Range("AL:AQ").EntireColumn.Hidden = True

Case "11"
Range("H:AN").EntireColumn.Hidden = False
Range("AO:AQ").EntireColumn.Hidden = True

Case "12"
Range("H:AQ").EntireColumn.Hidden = False


End Select
End If
End Sub



the 2nd thing is on the print page i need to do the same thing as above but as all the cells contain formulas such as =IF(COUNTA(Data!C9),Data!C9,"") it doesnt work, the value in the cell changes but wont hide columns unless its actually typed in again,

i done that instead of just =Data!C9 so that it doesnt show a 0 when there is nothing in the referenced cell

the final thing is also on the print sheet i want to hide entire rows based on the value of a cell, eg if G19 is greater than zero unhide Row 19, if anything else, hide Row 19.

this will repeat untill row 56, also the contents of say G19 is, as above, just a reference to a cell on the Data sheet, dont know if that makes any difference.

sorry its long, as thank you so much for any help you might have.

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("C9")) Is Nothing Then

With Target

Me.Columns("H:AQ").Hidden = False

If .Value >= 0 And .Value <= 12 Then

If .Value <> 12 Then

Me.Columns("H").Offset(0, (.Value * 3)).Resize(, 36 - (.Value * 3)).Hidden = True
End If
End If
End With
End If
End Sub

[Bob Phillips]

On the other point, do both sheets at the same time



Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("C9")) Is Nothing Then

With Target

Me.Columns("H:AQ").Hidden = False
Worksheets("Print").Columns("H:AQ").Hidden = False

If .Value >= 0 And .Value <= 12 Then

If .Value <> 12 Then

Me.Columns("H").Offset(0, (.Value * 3)).Resize(, 36 - (.Value * 3)).Hidden = True
Worksheets("Print").Columns("H").Offset(0, (.Value * 3)).Resize(, 36 - (.Value * 3)).Hidden = True
End If
End If
End With
End If
End Sub

[thebazman]

thanks xld, thats awesome, the code for the first section works perfectly, i tried to modify it for the 2nd section as it works slightly differently, but i couldnt get it to work properly,

the columns on the print sheet are H:AQ for all 12 instalments, however due to other info on the page i cant hide the first 2 instalments so if the value is 0, 1 or 2 it needs hide N:AQ

I modified to the following which works but obviously it will unhide everything when the value is 0, 1 or 2

any ideas on the 3rd thing, hiding entire rows eg hide row 19 if G19 is > 0


If Not Intersect(Target, Range("C9")) Is Nothing Then

With Target

Worksheets("Print").Columns("M:AO").Hidden = False

If .Value >= 3 And .Value <= 12 Then

If .Value <> 12 Then

Worksheets("Print").Columns("G").Offset(0, (.Value * 3)).Resize(, 36 - (.Value - 3 * 3)).Hidden = True

End If
End If
End With
End If

thanks for your help,

[mdmackillop]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long
If Not Intersect(Target, Range("C9")) Is Nothing Then
With Target
Me.Columns("H:AQ").Hidden = False
Worksheets("Print").Columns("H:AQ").Hidden = False
If .Value >= 0 And .Value <= 12 Then
x = .Value
If x <> 12 Then
Worksheets("Print").Range("G9") = x
Me.Columns("H").Offset(0, (x * 3)).Resize(, 36 - (x * 3)).Hidden = True
'Limit hidden columns due to other data
If x < 2 Then x = 2
Worksheets("Print").Columns("H").Offset(0, (x * 3) - 1).Resize(, 36 - (x * 3)).Hidden = True
End If
End If
End With
End If
End Sub

[thebazman]

Thanks mdmackillop thats excellent, that works a treat,

any thoughts on that 3rd problem?

this will make life so much easier,

[Bob Phillips]

Rows(19).hidden = Range("G19").Value <= 0

[thebazman]

thanks guys, i may be way off with this but i modified/merged to get code for the hidden rows,

but id have to repeat it for every row in the table i want it to run,, can it be put into some sort of loop, incrementing the row number? it will run from say C19 to C25


If Not Intersect(Target, Range("C19")) Is Nothing Then
With Target
Worksheets("Print").Rows(19).Hidden = False

If .Value <= (0) Then
Worksheets("Print").Rows(19).Hidden = True
End If

End With
End If

[Bob Phillips]

If Not Intersect(Target, Range("C19:C25")) Is Nothing Then
With Target

Worksheets("Print").Rows(.Row).Hidden = .Value <= 0
End With
End If

[thebazman]

thanks xld, that works great,

just 1 error i get using that, if i select 2 or 3 cells eg c19:c22 and hit the delete key it brings up the debugger and goes to this line of code, run time error 12, type mismatch
Worksheets("Print").Rows(.Row).Hidden = .Value <= 0

deleting 1 line at a time works fine though, any ideas?

i can live with it if thats the only way it can work,

[mdmackillop]

Change the start of the code as follows.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long
If Target.Cells.Count>1 Then Exit Sub
If Not Intersect(Target, Range("C9")) Is Nothing Then

[antonc]

Hi guys,

I want to be able to do the same thing as the 1st part of this thread ie. hide certain columns based on certain criteria.

However, I have many more more sheets in the workbook.
I tried variations of the code above, but I think I'm getting an erro because I'm using excel 2007.

This is the code I've come up with.


Sub Hide_Col()
'
' Hide_Col Macro
Dim J As Integer
Dim Numsheets As Integer
Dim Per As Range
Dim ran As Range
Dim cel As Range
Numsheets = Sheets.Count
For J = 2 To Numsheets
Sheets(J).Select
ActiveCell.Columns("A:DA").EntireColumn.Select
Selection.EntireColumn.Hidden = False
Set ran = Range("E5:P5")
Set Per = Range("E3")
For Each cel In ran.Cells
If cel = ("E3") Then cel.EntireColumn.Hidden
Next cel

Next J

End Sub

As I'm not sure of the number of sheets, I've decided to use a loop which works correctly.

I know there's something def wrong with the syntax.

In english, I want to through each sheet in the workbook, thereafter I want to hide all columns if the value in the range (E5:P5) is greater than the period (E3)

Your help will be much appreciated.

I've attached a file for your perusal...

Thanks in advance.

[mdmackillop]

Without checking your sample,

Option Explicit
Sub Hide_Col()
'
' Hide_Col Macro
Dim J As Integer
Dim Numsheets As Integer
Dim Per As Range
Dim ran As Range
Dim cel As Range
Numsheets = Sheets.Count
For J = 2 To Numsheets
With Sheets(J)
.Columns("A:DA").Hidden = False
Set ran = .Range("E5:P5")
Set Per = .Range("E3")
For Each cel In ran
If cel.Value = Per.Value Then cel.EntireColumn.Hidden = True
Next cel
End With
Next
End Sub

[antonc]

Thanks MD,

Works great....