Code for detail drill down / drill up article
This code is provided to simplify copying and pasting of the
annotated code from
my article on
drilling up and down in an Excel report.To use, set up the
Summary and Detail sheets using the download file as an example.
Copy this code into the sheet module of your summary sheet
(right-click the sheet tab, View Code, and paste)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Cells(2, Target.Column) = "Summary" Then
If Cells(3, Target.Column) = "Not expanded" Then
Insert_Block
ElseIf Cells(3, Target.Column) = "Expanded" Then
Delete_Block
End If
End If
End Sub
Copy this code into a new module in your workbook (press Alt+F11
to go to the code window, then Insert > Module and paste. To close
the code window press Alt+Q)
Option Explicit
Const SUMMARY_COLOR = 48
Const DETAIL_COLOR = 36
Sub Insert_Block()
Dim i As Integer
Dim CurCol As Long
Dim FirstDetailCol As Long
CurCol = ActiveCell.Column
Cells(1, CurCol).EntireColumn.Copy
Cells(1, CurCol).Resize(1, 6).Insert shift:=xlToRight
Cells(4, CurCol).Select
FirstDetailCol = WorksheetFunction.Match(ActiveCell.Value, _
Sheets("Forecast Detail").Range("1:1"), 0)
Sheets("Forecast Detail").Cells(2, FirstDetailCol).Resize(1, 6).Copy
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Selection.Offset(-2, 0).Value = "Detail"
Selection.Offset(-1, 0).ClearContents
Selection.Interior.ColorIndex = DETAIL_COLOR
ActiveCell.Offset(-1, 6).Value = "Expanded"
End Sub
Sub Delete_Block()
Dim i As Integer
Dim CurCol As Long
Dim FirstDetailCol As Long
CurCol = ActiveCell.Column
Cells(1, CurCol - 6).Resize(1, 6).EntireColumn.Delete shift:=xlToLeft
CurCol = CurCol - 6
Cells(4, CurCol).Select
Selection.Interior.ColorIndex = SUMMARY_COLOR
ActiveCell.Offset(-1, 0).Value = "Not expanded"
End Sub
To drill up or down, double-click any cell in a summary column.
