Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
' constants
' ranges
Const ksKey = "KeyCells"
Const ksParamAll = "ParamAllCell"
Const ksParamP = "ParamPCell"
Const ksParamS = "ParamSCell"
' values
Const ksTypeAll = "*"
Const ksTypeP = "P"
Const ksTypeS = "S"
'
' declarations
Dim rngK As Range, rngParamAll As Range, rngParamP As Range, rngParamS As Range
Dim sKey As String
Dim I As Integer
'
' start
' application
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
' parameters
Set rngParamAll = Range(ksParamAll)
Set rngParamP = Range(ksParamP)
Set rngParamS = Range(ksParamS)
' check
If Target.Cells.Count = 1 Then
If Application.Intersect(Target, rngParamAll) Is Nothing Then
If Application.Intersect(Target, rngParamP) Is Nothing Then
If Application.Intersect(Target, rngParamS) Is Nothing Then
sKey = ""
Else
sKey = ksTypeS
End If
Else
sKey = ksTypeP
End If
Else
sKey = ksTypeAll
End If
Else
sKey = ""
End If
' go?
If sKey = "" Then GoTo Worksheet_SelectionChange_Exit
' ranges
Set rngK = Range(ksKey)
'
' process
With rngK
' show all
.EntireColumn.Hidden = False
For I = 1 To .Columns.Count
If Not (.Cells(1, I).Value Like sKey) Then
' hide not matching
ActiveSheet.Columns(I + .Column - 1).Hidden = True
End If
Next I
End With
'
' end
' ranges
Set rngK = Nothing
Beep
Worksheet_SelectionChange_Exit:
Set rngParamS = Nothing
Set rngParamP = Nothing
Set rngParamAll = Nothing
' application
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
'
End Sub