Drill down using VBA

[Guinaba]

Hi guys,

Just wondering if someone could help me out, I have the following VBA code allowing the user to click in the active cell "+" and expand by the number of items within that brand. .

Sub Hide_SKU()
With Sheet1
    ActRow = ActiveCell.Row
    LastItemRow = ActiveCell.Offset(1, -1).End(xlDown).Row - 1
    ActiveCell.Value = "+"
    .Range(ActRow + 1 & ":" & LastItemRow).EntireRow.Delete
End With
End Sub

However, when I click again on ("-") I am getting the following error:

Run-time error "1004":
This won't work becasue it would move cells in a table on your worksheet

Here is the full VBA code if helps:

Option Explicit
Dim BrandIndex, Item As String
Dim LastItemRow, LastFiltRow, ActRow, ItemQty As Long

Sub Show_SKU()
With Sheet1
    ActRow = ActiveCell.Row
    BrandIndex = .Range("S" & ActRow).Value 'Get BrandIndex name
    LastItemRow = Sheet2.Range("c99999").End(xlUp).Row 'Get last row of items
    Sheet2.Range("v2,v5:ak99999").ClearContents 'Clear any previous data
    Sheet2.Range("v2").Value = BrandIndex
    Sheet2.Range("a1:p" & LastItemRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("v1:Ak2"), CopyToRange:=Sheet2.Range("v4:AK4"), Unique:=True
    LastFiltRow = Sheet2.Range("v99999").End(xlUp).Row  'Last FilterRow
    If LastFiltRow < 5 Then GoTo NoInv
    ItemQty = LastFiltRow - 4 'Get The Number of items
    ActiveCell.Value = "-"
    ActiveCell.EntireRow.Offset(1).Resize(ItemQty + 1).Insert Shift:=xlDown 'Inserts # of Rows + 1 for Header
    .Range("E" & ActRow + 1 & ":E" & ActRow + 1).HorizontalAlignment = xlLeft 'Justify Left item name
    .Range("E" & ActRow + 1 & ":R" & ActRow + 1).HorizontalAlignment = xlCenter 'Justify Center item numbers
    .Range("E" & ActRow + 1 & ":R" & ActRow + ItemQty).Value = Sheet2.Range("y5:AL" & LastFiltRow).Value 'Add Items
    .Range("E" & ActRow + 1 & ":R" & ActRow + 1).EntireColumn.AutoFit
     ActiveWorkbook.Worksheets("ByBrand").ListObjects("TotalIndiesPerformance").Sort _
        .SortFields.Add Key:=Range("J25"), SortOn:=xlSortOnValues, Order:= _
        xlDescending, DataOption:=xlSortTextAsNumbers
End With
Exit Sub
NoInv:
MsgBox "There are no Invoices for this customer"
End Sub

Sub Hide_SKU()
With Sheet1
    ActRow = ActiveCell.Row
    LastItemRow = ActiveCell.Offset(1, -1).End(xlDown).Row - 1
    ActiveCell.Value = "+"
    .Range(ActRow + 1 & ":" & LastItemRow).EntireRow.Delete
End With
End Sub

 

[diddi]

your are deleting rows in the table. i would suggest setting the rowheight to 0 and restoring again

 

[Guinaba]

Hi @diddi,
Thanks a lot for you suggestion, I've changed to code to RowHeight it is working now .
There is only one small issue, the drill down doesn't work, when clicking on "+" or "-" in sequence. I have to click in another cell and comeback to that cell with "+" in order to make it work. Would you know why? I am using the selectionChange event below to make that happen.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("e24:e5000")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub
    If Target.Value = "+" Then 'Show SKUs
         Show_SKU
         End
     End If
     If Target.Value = "-" Then 'Hide SKUs
           Hide_SKU
           End
     End If
 End If
 End Sub

 

[diddi]

your event handler is triggered by a change of cell selection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

change it to any change:

Private Sub Worksheet_Change(ByVal Target as Range)

 

[Guinaba]

your event handler is triggered by a change of cell selection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

change it to any change:

Private Sub Worksheet_Change(ByVal Target as Range)

Thanks @diddi! Spott on!!