Option Explicit
Dim lrow As Long
Dim lcol As Long
Dim i As Long
Sub aging_report()
If Evaluate("ISREF('Aging Data'!A1)") Then
Worksheets("Aging Data").Cells.Clear
Else
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Aging Data"
End If
Worksheets("Raw Data").Rows("1:1").Copy Worksheets("Aging Data").Range("A1")
With Worksheets("Raw Data")
lrow = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("1:1").AutoFilter
.Range("$A$1:$BR$" & lrow).AutoFilter field:=11, Criteria1:="="
.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets("Aging Data").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End With
lrow = Worksheets("Aging Data").Range("A" & Rows.Count).End(xlUp).Row
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Pivot_Tables"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Aging Data!R1C1:R" & lrow & "C70", Version:=xlPivotTableVersion10).CreatePivotTable _
TableDestination:="Pivot_Tables!R3C1", TableName:="PivotTable3", DefaultVersion _
:=xlPivotTableVersion10
ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
"PivotTable3").PivotFields("#"), "Count of #", xlCount
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Request time")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable3").PivotFields("Urgency")
.Orientation = xlColumnField
.Position = 1
End With
ActiveWorkbook.ShowPivotTableFieldList = False
Range("D4").Select
ActiveSheet.PivotTables("PivotTable3").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.Range("A4").Group Start:=True, End:=True, By:=1, Periods:=Array(False, _
False, False, True, False, False, False)
With Worksheets("Pivot_Tables")
lcol = .Cells(4, .Columns.Count).End(xlToLeft).Column
.Cells(4, lcol + 1).Value = "Aging in Days"
.Cells(4, lcol + 2).Value = "Aging Category"
i = 5
Do While .Range("A" & i).Value <> "Grand Total"
.Cells(i, lcol + 1).FormulaR1C1 = Date - CDate(.Range("A" & i).Value)
.Cells(i, lcol + 1).NumberFormat = "0"
.Cells(i, lcol + 2).FormulaR1C1 = "=IF(RC[-1]<=3,""0 to 3 Days"",IF(AND(RC[-1]>=4,RC[-1]<=7),""4 to 7 Days"",IF(AND(RC[-1]>=8,RC[-1]<=15),""8 to 15 Days"",IF(RC[-1]>15,""> 15 Days"",""""))))"
i = i + 1
Loop
.Cells.EntireColumn.AutoFit
.Range(.Columns(lcol + 1), .Columns(lcol + 2)).HorizontalAlignment = xlCenter
With .Range(.Cells(4, lcol + 1), .Cells(4, lcol + 2)).Font
.ThemeColor = xlThemeColorDark1
End With
With .Range(.Cells(3, lcol + 1), .Cells(4, lcol + 2)).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
End With
End With
Worksheets("Raw Data").Rows("1:1").AutoFilter
End Sub
Bookmarks