Hi Ruben,
I have got the impression that you partially pasted the code. However, you were supposed to use all code from my post #2, with the exception of the
GreyColumns procedure, which you should copy from post #3. Although the GreyColumns procedure does all the work, this procedure is called
indirectly and with the use of two mandatory arguments (parameters):
1) the type of action
2) the worksheet to which that action relates.
This way you can use the same procedure for multiple worksheets if desired. Due to the necessary arguments this procedure cannot be assigned to a button directly and is therefore not shown in the Assign Macro dialog (
Macro toewijzen aan object).
The GreyColumns procedure is called when the worksheet to be affected is activated (for initialization purposes).
The GreyColumns procedure is also called by the
GreyColumnsToggle procedure, the latter can be assigned to a custom button on your worksheet.
The code uses a random color as conditional color of which the number is assigned to the
cColor constant (on the third line), which easily can be changed.
The
ShowColor procedure can be used to obtain the number of the color you are using to distinguish those particular columns from the columns which must stay displayed. Select a single cell and invoke this procedure (Ribbon > Developer tab (
Ontwikkelaars) > Macros > ShowColor macro > Run (
Uitvoeren)). The obtained color number has to be assigned manually to the
cColor constant in the code (so replacing the random number 14277081).
I don't think merged cells will affect the operation of the code. Should this nevertheless prove to be the case, do unmerge these worksheet ranges and use text alignment instead (
Celeigenschappen > Uitlijning tab > Tekstuitlijning Horizontaal > Centreren over selectie), see attached images.
So for completeness...
This goes in the module of the (or each) desired worksheet:
VBA Code:
Private Sub Worksheet_Activate()
' retrieve toggle state
Call GreyColumns(Init, Me)
End Sub
This goes in a standard module:
VBA Code:
Option Explicit
Private Const cStartCol As String = "Q" ' << first column (and onwards) on sheet 'ProjectPlanning'
Private Const cColor As Long = 14277081 ' << color to act on
Private bVisible As Boolean
Private oSheet As Worksheet
Public Enum ColumnState
Init
Hide
Show
End Enum
Public Sub ShowColor()
Const cMsg As String = "Interior Color of cell @addr@ is: "
Dim sMsg As String
With Selection
If .CountLarge > 1 Then
MsgBox "Please select a single cell ..."
Else
sMsg = Replace(cMsg, "@addr@", .Address & " on sheet " & .Parent.Name) & .Interior.Color
MsgBox sMsg
End If
End With
End Sub
Public Sub GreyColumnsToggle()
If bVisible Then
Call GreyColumns(Hide, oSheet)
Else
Call GreyColumns(Show, oSheet)
End If
End Sub
Public Sub GreyColumns(ByVal argAction As ColumnState, ByRef argWs As Worksheet)
Dim oWsA As Worksheet
Dim oWsT As Worksheet
Dim rng As Range
Dim c As Range
If Not argWs Is Nothing Then
With argWs
' determine sheets most bottom row within target columns
Set rng = .Range(cStartCol & "1", Cells(1, .UsedRange.Column + UBound(.UsedRange.Formula, 2) - 1).EntireColumn)
Set rng = Application.Intersect(rng, .Cells(.Rows.Count, 1).EntireRow)
End With
Select Case argAction
Case Init
Set oSheet = argWs
bVisible = True
For Each c In rng.Columns
If c.Hidden Then
bVisible = False
Exit For
End If
Next c
Case Hide
For Each c In rng
If c.Interior.Color = cColor Then c.EntireColumn.Hidden = True
Next c
bVisible = False
Case Show
For Each c In rng
If c.Interior.Color = cColor Then c.EntireColumn.Hidden = False
Next c
bVisible = True
Case Else
' do nothing
End Select
Else
With Application
Set oWsA = ActiveSheet
.EnableEvents = True
For Each oWsT In oWsA.Parent.Sheets
If oWsT.Name <> oWsA.Name Then
.ScreenUpdating = False
oWsT.Activate
oWsA.Activate
.ScreenUpdating = True
Call GreyColumnsToggle
Exit For
End If
Next oWsT
End With
End If
End Sub
so you might experience a run-time error.
