Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveCell
Select Case .Column
Case 2
Dim varStart As Integer
Dim varFinish As Integer
Dim varRollupStart As Integer
Dim varRollupFinish As Integer
Dim varSubordHdr As Integer
Dim varHeaderCon As Integer
Dim strRange As String
Dim strCellValue As String
Dim rngToggle As Range
Dim rng2ndToggle As Range
Dim rngSubOrdToggle As Range
Dim strDCodeName As String
Select Case .Interior.Color
Case RGB(255, 255, 255)
If Right(.Value, 8) <> "(ROLLUP)" Then
varStart = .Row - 9
varFinish = .Row - 1
strDCodeName = StrConv(WorksheetFunction.Substitute(.Value, Left(.Value, 11), ""), vbProperCase)
Set rngToggle = .Rows(varStart & ":" & varFinish)
Select Case rngToggle.EntireRow.Hidden
Case True
rngToggle.EntireRow.Hidden = False
.Hyperlinks(1).ScreenTip = "Collapse " & strDCodeName
Case False
.Rows("2:10").EntireRow.Hidden = True
.Hyperlinks(1).ScreenTip = "Expand " & strDCodeName
End Select
Else
varStart = .Row - 9
varFinish = .Row - 1
Set rngToggle = Rows(varStart & ":" & varFinish)
Do
If varHeaderCon = 0 Then varHeaderCon = 10
varSubordHdr = .Row - varHeaderCon
varRollupStart = varSubordHdr - 9
varRollupFinish = varSubordHdr - 1
If rng2ndToggle Is Nothing Then
Set rng2ndToggle = .Rows(varRollupStart & ":" & varRollupFinish)
Set rngSubOrdToggle = .Rows(varSubordHdr & ":" & varSubordHdr)
Else
Set rng2ndToggle = Union(rng2ndToggle, .Rows(varRollupStart & ":" & varRollupFinish))
Set rngSubOrdToggle = Union(rngSubOrdToggle, .Rows(varSubordHdr & ":" & varSubordHdr))
End If
varHeaderCon = varHeaderCon + 10
Loop Until Range("B" & .Row - varHeaderCon).Interior.Color <> RGB(153, 153, 255)
varHeaderCon = varHeaderCon - varHeaderCon + 10
Select Case rngToggle.EntireRow.Hidden
Case True
rngToggle.EntireRow.Hidden = False
rngSubOrdToggle.EntireRow.Hidden = False
strDCodeName = StrConv(WorksheetFunction.Substitute(.Value, Left(.Value, 11), ""), vbProperCase)
.Hyperlinks(1).ScreenTip = "Collapse " & strDCodeName
Case False
Do
With Range("B" & .Row - varHeaderCon)
strDCodeName = StrConv(WorksheetFunction.Substitute(.Value, Left(.Value, 11), ""), vbProperCase)
.Hyperlinks(1).ScreenTip = "Expand " & strDCodeName
End With
varHeaderCon = varHeaderCon + 10
Loop Until Range("B" & .Row - varHeaderCon).Interior.Color = RGB(255, 255, 255)
rngToggle.EntireRow.Hidden = True
rngSubOrdToggle.EntireRow.Hidden = True
rng2ndToggle.EntireRow.Hidden = True
strDCodeName = StrConv(WorksheetFunction.Substitute(.Value, Left(.Value, 11), ""), vbProperCase)
.Hyperlinks(1).ScreenTip = "Expand " & strDCodeName
End Select
End If
Case Else
varStart = .Row - 9
varFinish = .Row - 1
Set rngToggle = .Rows(varStart & ":" & varFinish)
Select Case .Interior.Color
Case RGB(0, 0, 128)
strDCodeName = StrConv(WorksheetFunction.Substitute(.Value, "SUMMARY ", ""), vbProperCase)
Case RGB(153, 153, 255)
strDCodeName = StrConv(WorksheetFunction.Substitute(.Value, Left(.Value, 11), ""), vbProperCase)
End Select
Select Case rngToggle.EntireRow.Hidden
Case True
rngToggle.EntireRow.Hidden = False
.Hyperlinks(1).ScreenTip = "Collapse " & strDCodeName
Case False
rngToggle.EntireRow.Hidden = True
.Hyperlinks(1).ScreenTip = "Expand " & strDCodeName
End Select
End Select
Case 6
Case 9
End Select
End With
End Sub