Scribd
Upload
29 views2 pages

Dashboard Vba

This VBA script creates a dashboard with slicers in Excel by first deleting any existing sheets named 'Dashboard' and 'PivotData', then adding new ones. It copies data from 'Sheet1' to 'PivotData', creates a pivot table for parts analysis, and configures slicers for 'Buyer' and 'Week No'. Finally, it formats the dashboard, adds a legend, and handles any errors that may occur during the process.

Uploaded by

Izhar Mehdi
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
29 views2 pages

Dashboard Vba

This VBA script creates a dashboard with slicers in Excel by first deleting any existing sheets named 'Dashboard' and 'PivotData', then adding new ones. It copies data from 'Sheet1' to 'PivotData', creates a pivot table for parts analysis, and configures slicers for 'Buyer' and 'Week No'. Finally, it formats the dashboard, adds a legend, and handles any errors that may occur during the process.

Uploaded by

Izhar Mehdi
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd

Sub CreateDashboardWithSlicers()

On Error Resume Next

'Delete existing sheets if they exist


Application.DisplayAlerts = False
Sheets("Dashboard").Delete
Sheets("PivotData").Delete
Application.DisplayAlerts = True

'Add new sheets


Sheets.Add.Name = "Dashboard"
Sheets.Add.Name = "PivotData"

'Copy data to PivotData sheet


Sheets("Sheet1").UsedRange.Copy Sheets("PivotData").Range("A1")

'Create Pivot Cache


Dim pvtCache As PivotCache
Set pvtCache = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=Sheets("PivotData").UsedRange)

'Create Pivot Table


Dim pvtTable As PivotTable
Set pvtTable = pvtCache.CreatePivotTable( _
TableDestination:=Sheets("Dashboard").Range("B3"), _
TableName:="PartsAnalysis")

'Configure Pivot Table fields


With pvtTable
'Add Buyer field for Slicer
.PivotFields("Buyer").Orientation = xlHidden

'Add Week No field for Slicer


.PivotFields("Wk No").Orientation = xlHidden

'Add Assembly/Part to Rows


.PivotFields("Assembly/ Part").Orientation = xlRowField

'Add PO Note to Values


.AddDataField .PivotFields("Assembly/ Part"), "Count of Parts", xlCount

'Add PO Note to Columns


.PivotFields("PO Note").Orientation = xlColumnField
End With

'Create Slicers
Dim slcCache As SlicerCache

'Create Buyer Slicer


Set slcCache = ThisWorkbook.SlicerCaches.Add2( _
pvtTable, "Buyer", "BuyerSlicer")
With slcCache.Slicers.Add( _
Sheets("Dashboard"), , "Buyers", "Buyers", 10, 10, 150, 200)
.Style = "SlicerStyleLight1"
.Caption = "Select Buyer"
End With

'Create Week No Slicer


Set slcCache = ThisWorkbook.SlicerCaches.Add2( _
pvtTable, "Wk No", "WeekSlicer")
With slcCache.Slicers.Add( _
Sheets("Dashboard"), , "Weeks", "Weeks", 170, 10, 150, 200)
.Style = "SlicerStyleLight1"
.Caption = "Select Week"
End With

'Format Dashboard
With Sheets("Dashboard")
'Add Title
With .Range("B1")
.Value = "Parts Analysis Dashboard"
.Font.Size = 14
.Font.Bold = True
End With

'Format Pivot Table


With pvtTable
.ShowTableStyleRowStripes = True
.TableStyle2 = "PivotStyleLight16"
End With
End With

'Adjust columns width


Sheets("Dashboard").Columns.AutoFit

'Add Legend
With Sheets("Dashboard")
.Range("B" & pvtTable.TableRange2.Rows.Count + 5).Value = "Legend:"
.Range("B" & pvtTable.TableRange2.Rows.Count + 6).Value = "AVAILABLE: Parts
with available PO"
.Range("B" & pvtTable.TableRange2.Rows.Count + 7).Value = "STOCK: Parts
currently in stock"
.Range("B" & pvtTable.TableRange2.Rows.Count + 8).Value = "SHORTAGE: Parts
with procurement pending"
End With

'Activate Dashboard sheet


Sheets("Dashboard").Activate

'Error handling
If Err.Number <> 0 Then
MsgBox "An error occurred while creating the dashboard. Error: " &
Err.Description
End If
End Sub

You might also like