Option Explicit
Sub APPS_DBA_Dashboard_Quick_Refresh_All()
' ------------------------------------------------------------
' Consolidated macro for APPS DBA Team Lead dashboard
' Refresh + Color + Age calculation + Weekly summary
' Mohammed - Feb 2025 / 2026 version
' ------------------------------------------------------------
Dim ws As Worksheet
Dim rng As Range, cell As Range
Dim lastRow As Long, i As Long, outRow As Long
Dim dueDate As Date
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
On Error GoTo Finish
' 1. Refresh all data connections, pivots, formulas
ThisWorkbook.RefreshAll
ThisWorkbook.Worksheets("Dashboard").Calculate
' 2. Color status cells in main tracking sheets
Dim statusSheets As Variant
statusSheets = Array("ServiceNow", "RFC", "Release Tasks", "OEM", "Escalations", "Performance", "FlexDeploy")
Dim s As Variant
For Each s In statusSheets
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(s)
On Error GoTo Finish
If Not ws Is Nothing Then
' Try to find status column dynamically (looks for words like Status, State, Result)
Dim statusCol As Long
statusCol = 0
For i = 1 To 26
If InStr(1, LCase(ws.Cells(1, i).Value), "status") > 0 Or _
InStr(1, LCase(ws.Cells(1, i).Value), "state") > 0 Or _
InStr(1, LCase(ws.Cells(1, i).Value), "result") > 0 Then
statusCol = i
Exit For
End If
Next i
If statusCol > 0 Then
lastRow = ws.Cells(ws.Rows.Count, statusCol).End(xlUp).Row
If lastRow >= 2 Then
Set rng = ws.Range(ws.Cells(2, statusCol), ws.Cells(lastRow, statusCol))
For Each cell In rng
Select Case LCase(Trim(cell.Value))
Case "open", "in progress", "wip", "not started", "pending"
cell.Interior.Color = RGB(255, 192, 0) ' Orange
Case "critical", "high", "urgent", "blocked"
cell.Interior.Color = RGB(192, 0, 0) ' Red
Case "closed", "completed", "done", "success", "passed", "resolved"
cell.Interior.Color = RGB(0, 176, 80) ' Green
Case "failed", "error", "rolled back", "rejected"
cell.Interior.Color = RGB(255, 0, 0) ' Bright red
Case Else
cell.Interior.ColorIndex = xlNone
End Select
Next cell
End If
End If
End If
Next s
' 3. Calculate Age (days open) - ServiceNow & Escalations
Dim ageSheets As Variant
ageSheets = Array("ServiceNow", "Escalations")
For Each s In ageSheets
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(s)
On Error GoTo Finish
If Not ws Is Nothing Then
Dim dateCol As Long, ageCol As Long
dateCol = 0: ageCol = 0
For i = 1 To 30
Dim hdr As String: hdr = LCase(ws.Cells(1, i).Value)
If InStr(hdr, "open") > 0 Or InStr(hdr, "created") > 0 Or InStr(hdr, "raised") > 0 Then
dateCol = i
End If
If InStr(hdr, "age") > 0 Or InStr(hdr, "days") > 0 Then
ageCol = i
End If
Next i
If dateCol > 0 And ageCol = 0 Then
' If no Age column → create one at the end
ageCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column + 1
ws.Cells(1, ageCol).Value = "Age (days)"
ws.Cells(1, ageCol).Font.Bold = True
End If
If dateCol > 0 And ageCol > 0 Then
lastRow = ws.Cells(ws.Rows.Count, dateCol).End(xlUp).Row
For i = 2 To lastRow
If IsDate(ws.Cells(i, dateCol).Value) Then
ws.Cells(i, ageCol).Value = DateDiff("d", ws.Cells(i, dateCol).Value, Date)
Select Case ws.Cells(i, ageCol).Value
Case Is >= 30: ws.Cells(i, ageCol).Interior.Color = RGB(192, 0, 0)
Case Is >= 14: ws.Cells(i, ageCol).Interior.Color = RGB(255, 192, 0)
Case Else: ws.Cells(i, ageCol).Interior.ColorIndex = xlNone
End Select
End If
Next i
End If
End If
Next s
' 4. Quick weekly urgent summary → Plan sheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("ToDo")
Dim wsPlan As Worksheet
Set wsPlan = ThisWorkbook.Worksheets("Plan")
On Error GoTo Finish
If Not ws Is Nothing And Not wsPlan Is Nothing Then
wsPlan.Range("A8:F" & wsPlan.Rows.Count).ClearContents
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
outRow = 10
wsPlan.Cells(8, 1).Value = "Weekly Urgent Items (" & Format(Date, "dd-mmm-yyyy") & ")"
wsPlan.Cells(8, 1).Font.Bold = True
wsPlan.Cells(9, 1).Value = "Task": wsPlan.Cells(9, 2).Value = "Prio": _
wsPlan.Cells(9, 3).Value = "Owner": wsPlan.Cells(9, 4).Value = "Due": _
wsPlan.Cells(9, 5).Value = "Status": wsPlan.Cells(9, 6).Value = "Age"
For i = 2 To lastRow
If ws.Cells(i, "D").Value <> "" Then ' assuming Due Date in column D
dueDate = ws.Cells(i, "D").Value
If dueDate >= Date And dueDate <= Date + 7 Then
wsPlan.Cells(outRow, 1).Value = ws.Cells(i, "A").Value
wsPlan.Cells(outRow, 2).Value = ws.Cells(i, "B").Value
wsPlan.Cells(outRow, 3).Value = ws.Cells(i, "C").Value
wsPlan.Cells(outRow, 4).Value = dueDate
wsPlan.Cells(outRow, 5).Value = ws.Cells(i, "E").Value
If wsPlan.Cells(outRow, 4).Value <= Date Then
wsPlan.Range("A" & outRow & ":F" & outRow).Interior.Color = RGB(255, 230, 230) ' light red = overdue
ElseIf wsPlan.Cells(outRow, 4).Value <= Date + 3 Then
wsPlan.Range("A" & outRow & ":F" & outRow).Interior.Color = RGB(255, 242, 204) ' light orange
End If
outRow = outRow + 1
End If
End If
Next i
wsPlan.Range("A8:F" & outRow - 1).Borders.LineStyle = xlContinuous
wsPlan.Columns("A:F").AutoFit
End If
' 5. Final cleanup
Dim finalSheets As Variant
finalSheets = Array("Dashboard", "ServiceNow", "RFC", "Release Tasks", "Plan")
For Each s In finalSheets
On Error Resume Next
ThisWorkbook.Worksheets(s).Columns("A:Z").AutoFit
On Error GoTo Finish
Next s
Finish:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
If Err.Number <> 0 Then
MsgBox "Finished with warning(s)." & vbNewLine & Err.Description, vbExclamation, "APPS DBA Refresh"
Else
MsgBox "Dashboard refreshed & colored." & vbNewLine & _
"• Status colors updated" & vbNewLine & _
"• Ages calculated" & vbNewLine & _
"• Weekly urgent summary created", vbInformation, "APPS DBA Dashboard"
End If
End Sub
No comments:
Post a Comment