How to use VBA to change if an Excel file is visible (minimized) based on changes to the grand totals in a pivot table? - excel

Question

I have a live report in Excel that shows if cranes are currently delayed. What I would like to do, by using VBA, is to make it so that when a crane either starts a delay, or ends one, the file will go from being minimized to being expanded so that a user can be signalled for when a crane has gone on delay. I would also like this to only occur for the cranes that are present within the table after being filtered.
I have attached an image of the data along with the relevant filter for cranes.
Crane Delay Data with Crane Filter
My thinking was to scan the Grand Total column, and if the value has changed from being empty to having a figure greater than 0 (and vice versa) to trigger a Macro that will make the file visible.
If possible, what code would I need to use and how would I go about doing this?
Many thanks.

Answer 1

For those interested, I have come up with a solution. Please leave a comment if you want me to talk through it. Code is below:
Option Explicit
Private Sub Worksheet_PivotTableAfterValueChange(ByVal TargetPivotTable As PivotTable, ByVal TargetRange As Range)
End Sub
Public Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim pt As PivotTable
Dim wsBackup As Worksheet
Dim c As Range
Dim rngPivot As Range
Dim lastCol As Long
Dim strCrane As String
Dim sValues As Variant
sValues = ArrayListOfSelectedAndVisibleSlicerItems("Slicer_QC1")
'Change to suit
Set pt = Me.PivotTables("PivotTable1")
'Where has a copy of table been saved?
Set wsBackup = ThisWorkbook.Worksheets("Pivot Copy")
Set rngPivot = pt.DataBodyRange
'How many columns?
lastCol = rngPivot.Columns.Count
Application.ScreenUpdating = False
'Check each cell in last column/grand total
For Each c In rngPivot.Columns(lastCol).Cells
'What item is this?
strCrane = c.Offset(0, -lastCol).Value
'Escape clause
If strCrane = "Grand Total" Then Exit For
If c.Value = 0 Then
'Use a function that won't throw an error
'Note we add 1 to account for row labels
If WorksheetFunction.SumIfs(wsBackup.Columns(1 + lastCol), _
wsBackup.Range("A:A"), strCrane) <> 0 Then
If IsInArray(strCrane, sValues) = True Then
ActiveWindow.WindowState = xlMaximized
MsgBox strCrane & " has ended a delay" & vbCrLf & vbCrLf & "(Minimise Excel after using file)"
End If
End If
ElseIf c.Value > 0 Then
If WorksheetFunction.SumIfs(wsBackup.Columns(1 + lastCol), _
wsBackup.Range("A:A"), strCrane) = 0 Then
If IsInArray(strCrane, sValues) = True Then
ActiveWindow.WindowState = xlMaximized
MsgBox strCrane & " has started a delay" & vbCrLf & vbCrLf & "(Minimise Excel after using file)"
End If
End If
End If
Next c
'Save our new backup
wsBackup.Cells.Clear
pt.TableRange2.Copy
wsBackup.Range("A1").PasteSpecial xlPasteValues
'Clean up
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Function ArrayListOfSelectedAndVisibleSlicerItems(MySlicerName As String) As Variant
'This function returns an array of the limited set of items in Slicer A
'Limitation is due to both:
'(1) direct selection of items by user in slicer A
'(2) selection of items in slicer B which in consequence limits the number of items in slicer A
Dim ShortList() As Variant
Dim i As Integer: i = 0 'for iterate
Dim sC As SlicerCache
Dim sI As SlicerItem 'for iterate
Set sC = ThisWorkbook.SlicerCaches(MySlicerName)
For Each sI In sC.SlicerItems
If sI.Selected = True Then
' Debug.Print sI.Name
ReDim Preserve ShortList(i)
ShortList(i) = sI.Value
i = i + 1
End If
Next sI
ArrayListOfSelectedAndVisibleSlicerItems = ShortList
End Function
Private Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = UBound(Filter(arr, stringToBeFound)) > -1
End Function