Create Multiple Slicers Using Table Data Automatically

How to create multiple slicers using table data automatically with VBA. Last time we learnt how to create a single slicer automatically. With multiple slicers we can use multiple criteria to filter and analyze data quickly and easily. The filtering process requires only a single click or a few clicks and a report is generated at once. Watch the video:

Create Multiple Slicers Using Table Data Automatically

Here’s the complete VBA code to create many slicers from table data in an Excel worksheet automatically:

Sub CreateTable()
ThisWorkbook.Worksheets(“Sheet1”).ListObjects.Add(xlSrcRange, [A1].CurrentRegion, , xlYes).Name = “myTable”

End Sub

Sub CreateSlicers()

Dim rng As Range
Dim sl As Slicer
Dim sc As SlicerCache
Dim ws As Worksheet

Dim lastColumn As Long
lastColumn = Cells.Find(What:=”*”, _
After:=Range(“A1”), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Dim p As Long
p = 20

Set ws = Worksheets(“Sheet1”)
On Error Resume Next

For i = 1 To lastColumn

If Cells(1, i).Text = "Sales Person" Or Cells(1, i).Text = "Item" Or Cells(1, i).Text = "Sale Date" Then
'Set sc = ThisWorkbook.SlicerCaches.Add2(Sheet1.ListObjects("myTable"), "Sales Person")
Set sc = ThisWorkbook.SlicerCaches.Add2(Sheet1.ListObjects("myTable"), Cells(1, i).Text)

'Set sl = sc.Slicers.Add(ws, , "sales Person", "Select Sales Person")
Set sl = sc.Slicers.Add(ws, , Cells(1, i).Text, "Select" & " " & Cells(1, i).Text)

Set rng = Range("A1:E1")
sl.Top = rng.Top
sl.Left = rng.Left + rng.Width + p
sl.Width = 150 'there are 72 points to an inch or 28.35 points to a centimeter
sl.Height = 120
p = p + 160

End If

Next i

End Sub

Here’s also the recorded macro code:

Sub Macro1()

‘ Macro1 Macro


Range(“C9”).Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(“myTable”), _
“Sales Person”).Slicers.Add ActiveSheet, , “Sales Person”, “Sales Person”, _
39.75, 444.75, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(“myTable”), “Item”). _
Slicers.Add ActiveSheet, , “Item”, “Item”, 77.25, 482.25, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(“myTable”), _
“Price *Rs.)”).Slicers.Add ActiveSheet, , “Price *Rs.)”, “Price *Rs.)”, 114.75 _
, 519.75, 144, 198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(“myTable”), “Qty Sold” _
).Slicers.Add ActiveSheet, , “Qty Sold”, “Qty Sold”, 152.25, 557.25, 144, _
198.75
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects(“myTable”), _
“Sale Date”).Slicers.Add ActiveSheet, , “Sale Date”, “Sale Date”, 189.75, _
594.75, 144, 198.75
ActiveSheet.Shapes.Range(Array(“Sale Date”)).Select

End Sub