Untitled

 avatar
unknown
plain_text
22 days ago
3.2 kB
1
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
Leave a Comment