Option Explicit
Sub CreateRootCauseGraph()
Dim source As Variant
Dim newSheet As Variant
Dim reportNumberColumn As String
Dim rootCauseColumn As String
Dim closureCodeColumn As String
Dim statusColumn As String
Set source = Sheets("PQR_list") ' name of the sheet containing the PQR list
reportNumberColumn = "A ' column containing the report number
rootCauseColumn = "E" ' column containing the Root Cause / analyze
closureCodeColumn = "H" ' column containing the Closure Code
statusColumn = "D" ' column containing the Status
Dim totalNumber As Integer
Dim incrNumber As Integer
totalNumber = source.UsedRange.Rows.Count
incrNumber = 1
Application.ScreenUpdating = False
' --- --- --- create new sheet to record root cause of each PQR ---
Set newSheet = Worksheets.Add
newSheet.Name = "Root Cause Analysis"
newSheet.Cells(incrNumber, 1) = "identifier"
newSheet.Cells(incrNumber, 2) = "root cause"
' --- --- --- extract root cause of each PQR ---
Dim i As Integer
Dim text As String
Dim pos As Integer
For i = 1 To totalNumber
If (source.Cells(i, closureCodeColumn) = "CA taken" And _
(source.Cells(i, statusColumn) = "Resolved" Or _
source.Cells(i, statusColumn) = "Verified" Or _
source.Cells(i, statusColumn) = "Closed")) Then
incrNumber = incrNumber + 1
text = source.Cells(i, rootCauseColumn)
pos = InStr(text, "]")
If ((Left(text, 1) = "[") And (pos > 1)) Then
text = Mid(text, 2, pos - 2)
Else
text = "?"
End If
newSheet.Cells(incrNumber, 1) = source.Cells(i, reportNumberColumn)
newSheet.Cells(incrNumber, 2) = text
End If
Next i
' --- --- --- create pivot table ---
Dim table As Variant
Set table = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="'Root Cause Analysis'!A:B").CreatePivotTable(Range("D1"))
table.AddFields RowFields:="root cause"
table.PivotFields("identifier").Orientation = xlDataField
table.DataFields(1).Function = xlCount
Dim numberOfValues As Integer
numberOfValues = table.DataBodyRange.Rows.Count
' --- --- --- create chart ---
Dim chart As Variant
Set chart = Charts.Add
chart.ChartType = xlColumnClustered
chart.SetSourceData source:=Sheets("Root Cause Analysis").Range("A1:B" & incrNumber), PlotBy:=xlRows
chart.SeriesCollection(1).XValues = "='Root Cause Analysis'!R3C4:R" & numberOfValues & "C4"
chart.SeriesCollection(1).Values = "='Root Cause Analysis'!R3C5:R" & numberOfValues & "C5"
chart.HasLegend = False
chart.HasDataTable = False
chart.HasTitle = False
chart.Location Where:=xlLocationAsObject, Name:="Root Cause Analysis"
Application.ScreenUpdating = True
End Sub |