Untitled
unknown
plain_text
a year ago
3.2 kB
5
Indexable
Private Sub Worksheet_Change(ByVal Target As Range)
Dim yearsInCompany As Long
Dim totalGroups As Long
Dim startCol As Long
Dim endCol As Long
Dim colRange As String
Dim i As Long
Dim k7Value As String
Dim splitValues() As String
' Unprotect the sheet
Me.Unprotect Password:="111111"
' Unlock grouped columns
Me.Columns("Q:CU").Locked = False
' Check if K6 or K7 was changed
If Not Intersect(Target, Me.Range("K6:K7")) Is Nothing Then
Application.EnableEvents = False ' Prevent recursive triggers
Debug.Print "Change detected in K6 or K7" ' Debugging
' Validate K7 value
If IsEmpty(Me.Range("K7").Value) Then
Me.Columns("Q:CR").Hidden = True
Me.Outline.ShowLevels ColumnLevels:=1
' Reapply protection with UserInterfaceOnly to enable Outliner and allow grouping
Me.Protect Password:="111111", _
UserInterfaceOnly:=True, AllowFormattingColumns:=True
Me.EnableOutlining = True ' Enable Outlining after protection
Application.EnableEvents = True
Exit Sub
End If
' Extract "years" from K7
k7Value = Me.Range("K7").Value
splitValues = Split(k7Value, " years") ' Split based on " years"
If UBound(splitValues) >= 0 Then
yearsInCompany = Val(splitValues(0)) ' Get the numeric value before " years"
Else
yearsInCompany = 0 ' Default if no years found
End If
' Ensure at least 1 year is considered
yearsInCompany = yearsInCompany + 1
' Define grouping parameters
totalGroups = 20 ' 20 groups, 4 columns each
startCol = 17 ' Column Q is the 17th column
' Loop through groups to hide/unhide
For i = 1 To totalGroups
endCol = startCol + 3 ' Each group spans 4 columns
' Convert column numbers to letters
Dim startColLetter As String, endColLetter As String
startColLetter = Split(Me.Cells(1, startCol).Address(False, False), "$")(0)
endColLetter = Split(Me.Cells(1, endCol).Address(False, False), "$")(0)
If i <= yearsInCompany Then
' Unhide the group while keeping it collapsed
Me.Range(startColLetter & ":" & endColLetter).EntireColumn.Hidden = False
Else
' Hide the group
Me.Range(startColLetter & ":" & endColLetter).EntireColumn.Hidden = True
End If
' Move to the next group
startCol = startCol + 4
Next i
' Collapse all groups
Me.Outline.ShowLevels ColumnLevels:=1
End If
' Reapply protection and enable outlining
Me.Protect Password:="111111", UserInterfaceOnly:=True, AllowFormattingColumns:=True
Me.EnableOutlining = True
' Ensure events are re-enabled
Application.EnableEvents = True
Exit Sub
ErrorHandler:
MsgBox "An error occurred: " & Err.Description, vbCritical
Debug.Print "Error: " & Err.Number & " - " & Err.Description
Application.EnableEvents = True
End Sub
Editor is loading...
Leave a Comment