Sub AAInvoiceSplit()
Application.ScreenUpdating = False
' ICPIA Tidyup
Dim DSheet As Worksheet
Set DSheet = ActiveSheet
Range("W1:AR1").Cut
Rows("2:2").Insert shift:=xlDown
Columns("P:P").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("O:O").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("O1").FormulaR1C1 = "Duration (Mins)"
Range("Q1").FormulaR1C1 = "Data Usage (Gb)"
Range("O2").FormulaR1C1 = "=RC[-1]/60"
Range("Q2").FormulaR1C1 = ""
LastRow1 = Cells(Rows.Count, "A").End(xlUp).Row
Range("O2:O" & LastRow1).Formula = "=N2/60"
Range("Q2:Q" & LastRow1).Formula = "=P2/1024/1024"
Range("A1:U" & LastRow1).Copy
Range("A1:U" & LastRow1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("U:V,S:S").Delete shift:=xlToLeft
' Split charges to one mobile number per tab
'Declare Variables
Dim PSheet As Worksheet
'Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim Lastrow As Long
Dim LastCol As Long
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
'Set DSheet = Worksheets("Data")
'Define Data Range
Lastrow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(Lastrow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="Pivot")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="Pivot")
'Insert Row Fields
With ActiveSheet.PivotTables("Pivot").PivotFields("Carrier Description" & Chr(13) & "")
.Orientation = xlRowField
.Position = 1
End With
'Insert Columns and split to tabs
With ActiveSheet.PivotTables("Pivot").PivotFields("Mobile #")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("Pivot").AddDataField ActiveSheet.PivotTables( _
"Pivot").PivotFields("Ex Tax Amount"), "Sum of Ex Tax Amount", xlSum
With ActiveSheet.PivotTables("Pivot").PivotFields("Sum of Ex Tax Amount")
.NumberFormat = "$#,##0.00"
End With
ActiveSheet.PivotTables("Pivot").PivotFields("Carrier Description" & Chr(13) & ""). _
AutoSort xlDescending, "Sum of Ex Tax Amount", ActiveSheet.PivotTables( _
"Pivot").PivotColumnAxis.PivotLines(1), 1
ActiveSheet.PivotTables("Pivot").RowGrand = False
ActiveSheet.PivotTables("Pivot").ShowPages PageField:="Mobile #"
' Remove Pivot formatting from all tabs
Dim xsheet As Worksheet
For Each xsheet In ThisWorkbook.Worksheets
xsheet.Select
RemovePivots
Next xsheet
End Sub
Sub RemovePivots()
Range("A3:B90").Copy
Range("A101").Select
With Selection
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End With
Range("A1:B1").Copy
Range("A99").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows("1:98").Delete shift:=xlUp
Columns("A").Replace _
What:="Row Labels", Replacement:="Category", _
SearchOrder:=xlByColumns, MatchCase:=True
Dim LastRow3 As Integer
LastRow3 = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Rows(LastRow3 & ":" & LastRow3).Delete shift:=xlUp
Dim LastRow4 As Integer
LastRow4 = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A3:B" & LastRow4), , xlYes).Name = _
"Table1"
ActiveSheet.ListObjects("Table1").ShowTotals = True
End Sub
Bookmarks