DataWright Information Services

Consulting and Resources for Excel and Access




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.