Automatic hiding of columns based on a cell value

[Hippolyte]

Hello,


I have this macro to hide columns based on the value of a cell but I would like to know how I could tweek it to make it hide 2 columns at a time ?


Thank you very much for your help !


Best regards,
Hippolyte




Private Sub Worksheet_Change(ByVal Target As Range)
Dim rMin As Integer, rMax As Integer, i As Integer, ws As String
ws = "Feuille de calcul"
rMin = 10
rMax = 32


If Target.Address = "$H$10" Then
If Target.Value >= 1 And Target.Value <= 22 Then
rSave = rMin
Do
Worksheets(ws).Columns(rMin).EntireColumn.Hidden = False
rMin = rMin + 1
Loop While rMin <= rMax
rMin = rSave
i = Target.Value
rMin = rMin + i + 1
If rMin > rMax Then
rMin = rMax
End If
Do

Worksheets(ws).Columns(rMin).EntireColumn.Hidden = True
rMin = rMin + 1
Loop While rMin <= rMax
End If
End If
End Sub

 

[LateralThinker]

Hi
Change the hidden code to this way.

Worksheets(ws).Columns(rMin).Resize(, 2).EntireColumn.Hidden = True


thanks.

 

[Hippolyte]

Hello @LateralThinker,

Thank you for your input ! Now the code does hide columns again but it does reveal half the columns I would want.

eg: If the cell value "$H$10"=7; it shows me 7 columns but I want to see 14 columns.

Don't know if I'm clear enough ?

Thanks for your initial input ! And thanks again for your help

 

[LateralThinker]

Hi

Sorry for the late answer.

I have two solution with this.

#1 is I just put in '*2' in your code. And #2 is another solution for this.

If you have any questions, do not hesitate.

thanks.

Solution #1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rMin As Integer, rMax As Integer, i As Integer, ws As String
ws = "Feuille de calcul"
rMin = 10
rMax = 32

If Target.Address = "$H$10" Then
If Target.Value >= 1 And Target.Value <= 22 Then
rSave = rMin
Do
Worksheets(ws).Columns(rMin).EntireColumn.Hidden = False
Worksheets(ws).Columns(rMin).EntireColumn.Interior.Color = xlNone
rMin = rMin + 1
Loop While rMin <= rMax
rMin = rSave
i = Target.Value
rMin = rMin + i * 2 + 1
If rMin > rMax Then
rMin = rMax
End If
Do
Worksheets(ws).Columns(rMin).EntireColumn.Hidden = True
Worksheets(ws).Columns(rMin).EntireColumn.Interior.Color = RGB(128, 128, 128)
rMin = rMin + 1
Loop While rMin <= rMax
End If
End If
End Sub



Solution #2

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rMin As Integer, rMax As Integer, i As Integer, ws As String, rInputValue As Integer
ws = "Feuille de calcul"
rMin = 10
rMax = 32
If Target.Address = "$H$10" Then
rInputValue = Target.Value
If rInputValue >= 1 And rInputValue <= 22 Then
'UnHidden Columns
Worksheets(ws).Columns(rMin).Resize(, rMax - rMin + 1).EntireColumn.Hidden = False
'Hidden Columns
Worksheets(ws).Columns(rMin).Offset(, rInputValue * 2).Resize(, rMax - rMin + 1 - rInputValue * 2).EntireColumn.Hidden = True
End If
End If
End Sub