What usually happens in the service industry is that we have monthly report from a tool – HPSM / Remedy / SNOW – whatever.

And we need to present management the status every day.

Capture1

This is essential RAG summary.

Capture2.JPG

Let’s get down to coding

‘—————————————————–

Sub MyMacro4()

Dim mysheet As Worksheet
Set mysheet = ActiveWorkbook.ActiveSheet ‘Set raw data sheet as the sheet on which to run macro

‘The below code finds the columns in which various required data columns are
AssignmentColumn = getColFromAddr(getAddress(mysheet, “Assignment”))
IMNUmber = getColFromAddr(getAddress(mysheet, “Case ID”))
PriorityCol = getColFromAddr(getAddress(mysheet, “Priority Code”))
SLACol = getColFromAddr(getAddress(mysheet, “1 day SLA status”))
ResolvedCol = getColFromAddr(getAddress(mysheet, “Resolution Time”))

‘This code below finds all the different assignment groups in the report
‘To start from 2nd row of the row data
Start_At = 2
Dim Unique() As String ‘ we will store our assignment groups in an array or strings
ReDim Unique(0)
Unique(0) = mysheet.Cells(Start_At, AssignmentColumn) ‘Storing first assignment group manually

For I = 3 To mysheet.UsedRange.Rows.Count ‘Running loop from third row to last used row

Number = UBound(Unique()) ‘Ubound function finds the max stored range of array
Found = 1 ‘this a flag that will tell us if the assignment group is already in array or not

For j = 0 To UBound(Unique()) ‘This loop within a loop runs from Zero to last of array

If Unique(j) = mysheet.Cells(I, AssignmentColumn) Then Found = 0 ‘We are comparing the assignment group already stored in array with the entry in raw data and if found, marks it
Next j

If Found = 1 Then
ReDim Preserve Unique(Number + 1) ‘ If yes then redefine the array and store next
Unique(Number + 1) = mysheet.Cells(I, AssignmentColumn)
End If

Next I

‘The code below adds the sheet and adds the headers.

Sheets.Add
ActiveSheet.Name = “Summary”
Set summarysheet = Worksheets(“Summary”)
summarysheet.Cells(1, 1) = “Assignment Group”
summarysheet.Cells(1, 1).Font.Bold = True
summarysheet.Cells(1, 2) = “Delivery Agreement”
summarysheet.Cells(1, 2).Font.Bold = True

For I = 1 To Day(Date) ‘This to add daily status days to summary

summarysheet.Cells(1, 3 * I) = DateValue(I & “/” & Month(Date) & “/” & Year(Date))
summarysheet.Cells(2, 3 * I) = “Cumulative P4 Solved”

summarysheet.Cells(1, 3 * I + 1) = DateValue(I & “/” & Month(Date) & “/” & Year(Date))
summarysheet.Cells(2, 3 * I + 1) = “Cumulative P4 1 Day SLA Broken”

summarysheet.Cells(1, 3 * I + 2) = DateValue(I & “/” & Month(Date) & “/” & Year(Date))
summarysheet.Cells(2, 3 * I + 2) = “1 Day SLA %age”

Next I

For I = 0 To UBound(Unique()) ‘This loop will run for all assignment groups one by one

summarysheet.Cells(3 + I, 1) = Unique(I) ‘Add the name of assignment group to summary

For j = 2 To mysheet.UsedRange.Rows.Count ‘Run the loop from Row 2 to last row of raw data

If mysheet.Cells(j, AssignmentColumn) = Unique(I) Then ‘If the assignment group matches the required assignment group then go on

If mysheet.Cells(j, PriorityCol) = 4 Then ‘The SLA is only applicable for Priority 4 Tickets

Resolved_Date = DateValue(mysheet.Cells(j, ResolvedCol)) ‘Storing the date the incident solved in one variable

For k = 1 To summarysheet.UsedRange.Columns.Count ‘This Loop finds the date where it is equal to date the incident solved (Resolved Date) variable

Summary_Data = summarysheet.Cells(1, 3 * k) ‘Storing the date found on summary sheet in a variable

If Resolved_Date = Summary_Data Then

summarysheet.Cells(3 + I, 3 * k) = summarysheet.Cells(3 + I, 3 * k) + 1 ‘Add the total by 1 for that day

If mysheet.Cells(j, SLACol) = “SLA broken” Then summarysheet.Cells(3 + I, 3 * k + 1) = summarysheet.Cells(3 + I, 3 * k + 1) + 1 ‘If the SLA is broken then add 1 to SLA broken column

Exit For ‘Exit the loop to proceed to next incident.

End If

Next k

End If

End If

Next j

Next I

summarysheet.Select

For I = 0 To UBound(Unique()) ‘Run for all assignment groups one by one

For k = 2 To ActiveSheet.UsedRange.Columns.Count ‘This runs for all the columns of the summary sheet

If ActiveSheet.Cells((1 + I), (3 * k)) = “” Then Exit For ‘Exit once you encounter blanks

If ActiveSheet.Cells((3 + I), (3 * k)) = “” Then ActiveSheet.Cells((3 + I), (3 * k)) = 0 ‘This puts Zero instead of blanks
If ActiveSheet.Cells((3 + I), (3 * k + 1)) = “” Then ActiveSheet.Cells((3 + I), (3 * k + 1)) = 0 ‘This puts Zero instead of blanks

ActiveSheet.Cells((3 + I), (3 * k)).Select
ActiveCell.FormulaR1C1 = “=RC[-3]+” & ActiveSheet.Cells((3 + I), (3 * k)) ‘This formula adds the current value to 3 cells left of it
ActiveSheet.Cells((3 + I), (3 * k + 1)).Select
ActiveCell.FormulaR1C1 = “=RC[-3]+” & ActiveSheet.Cells((3 + I), (3 * k + 1)) ‘This formula adds the current value to 3 cells left of it

ActiveSheet.Cells((3 + I), (3 * k + 2)).Select
ActiveCell.FormulaR1C1 = “=1-(RC[-1]/RC[-2])” ‘This formula calculates the SLA, Substrating the SLA Broken divided by Total Incidents from 1
Selection.Style = “Percent”
Selection.NumberFormat = “0.00%”

Next k
Next I

Set mysheet = ActiveWorkbook.ActiveSheet

Lastcolumn = mysheet.UsedRange.Columns.Count

Sheets.Add ‘Create a new sheet
ActiveSheet.Name = “Status” ‘Rename the sheet to Status

Set statussheet = ActiveWorkbook.ActiveSheet
statussheet.Cells(1, 1) = “Track”
statussheet.Cells(1, 1).Font.Bold = True

statussheet.Cells(1, 2) = “1 Day SLA Status”
statussheet.Cells(1, 2).Font.Bold = True

For I = 0 To UBound(Unique())

statussheet.Cells(2 + I, 1) = Unique(I)

For j = 3 To mysheet.UsedRange.Rows.Count

If mysheet.Cells(j, 1) = Unique(I) Then

statussheet.Cells(2 + I, 2) = mysheet.Cells(j, Lastcolumn) ‘Pick the data from the last Column of the summary sheet
‘This code was recorded on a sample data and then modified and added here
statussheet.Cells(2 + I, 2).Style = “Percent”
statussheet.Cells(2 + I, 2).NumberFormat = “0.00%”
statussheet.Cells(2 + I, 2).Select

‘This code conditional formats the cell as per the requirements
‘This code was recorded on a sample data and then modified and added here
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:=”=0.8″
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:=”=0.8″, Formula2:=”=0.9″
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
, Formula1:=”=0.9″
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False

Exit For

End If
Next j
Next I
statussheet.Select

Dim LastCol As Integer

Lastrow = statussheet.UsedRange.Rows.Count
LastCol = statussheet.UsedRange.Columns.Count

MyLastCol = getStrOfCol(LastCol) ‘ This function returns column name on numerical input – getStrOfCol(5) = “E”

Myrange = “A1:B” & Lastrow

‘Below code formats the sheet ie, Color the header and add borders
‘This code was recorded on a sample data and then modified and added here
Columns(“A:B”).Select
Columns(“A:B”).EntireColumn.AutoFit
Range(Myrange).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

Range(“A1:B1”).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With

End Sub

 

‘——————————————————–

Be wary that this code is very date dependent and if you are running in say Ap17 then change the dates in column K- ‘Resolution Time’ to Apr 17. 

Attached is the full file on how to do it.

Make Summary Advanced – SLA Break – VBA

Now, can you mail this to the manager or Mail the file individually to each group or make charts?

Yes, Yes and Yes

Mailing Charts to different employees – VBA / Excel

Split data into sheets – VBA Excel

Mail the Summary – VBA / Excel

You see how small building blocks can be combined to make complex one-click reports.

Cheers

CuriosJatin

Advertisements