Need to sort/group locations in sheet1 based on order criteria provided in sheet4

[aleanboy]

Hi All,


I have a macro code which will create the report as shown in Sheet1.
Now once the report is generated in sheet1, I would like to group the locations & insert few rows in sheet1 based on the order criteria shown in Sheet4. So that my final report should be present as shown in Sheet “Summary”.

Please advise what else should I include with the below code

Private Sub CommandButton1_Click()

Dim PvtTbl As PivotTable
Dim PvtTblCache As PivotCache
Dim ws As Worksheet, wsPvtTbl As Worksheet
Dim rng As Range, Pvtrng As Range, Pvtcell As Range, Mrng As Range
Dim lr As Long, Pvtlr As Long
Application.ScreenUpdating = False
Set ws = Sheets("Sheet3")
lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = ws.Range("A1:E" & lr)
Set wsPvtTbl = Sheets("Sheet1")
'wsPvtTbl.Cells.Clear
For Each PvtTbl In wsPvtTbl.PivotTables
    'PvtTbl.TableRange2.Clear
Next PvtTbl
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng, _
Version:=xlPivotTableVersion12).CreatePivotTable tabledestination:=wsPvtTbl.Range("D6"), _
TableName:="PivotTable1", defaultversion:=xlPivotTableVersion12

Set PvtTbl = wsPvtTbl.PivotTables("PivotTable1")
wsPvtTbl.Select
    With PvtTbl.PivotFields("Invoiced By")
        .Orientation = xlRowField
        .Position = 1
        .Subtotals(1) = False
    End With
    
    With PvtTbl.PivotFields("Gross Profit")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With
    With PvtTbl.PivotFields("Gross Profit")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 2
    End With
    
    With PvtTbl.PivotFields("MTD Gross")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 3
    End With
    
        With PvtTbl
        .RowAxisLayout xlTabularRow
    End With
Pvtlr = wsPvtTbl.Cells(Rows.Count, 1).End(xlUp).Row

With Range("D7:G7")
    .Interior.ColorIndex = 1
    .Font.ColorIndex = 2
    .Font.Size = 12
    .Font.Bold = True
End With
'With Range("D" & Pvtlr & ":D" & Pvtlr)
 '   .Interior.ColorIndex = 2
  '  .Font.ColorIndex = 2
'End With

wsPvtTbl.Columns.AutoFit
Range("D1").Select
Application.ScreenUpdating = True

    With ActiveSheet.UsedRange
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Cells(1).Select
    End With
    
    Rows(5).Delete
    
    Application.CutCopyMode = False

MsgBox "Report has been created successfully."


End Sub