How subtotal in excel based on if condition.

I have a report and wants to subtotal based on column B (Account description) with the following criteria.
If Account Description is "Account Payable-Control" or "Amort - Leasing Commissions"  then subtotal and name the row as Accounting
esle if
If Account Description is "Impermis Cost Transfer " or "Impermis Income Transfer"  then subtotal and name the row as Transfer Cost
else if
If Account Description is "Leasing Comm - Accum Amort " or "Leasing Commissions"  then subtotal and name the row as Leasing
Else
Account Description other than above then subtotal all other and name the row as othere
in the end of data Grand total.

In report I already have a button name Calculate Amont that calculate the subtotal based on each category of Account Description. Calcualte Amont have following code for subtotal.
See attachced report for more info

I was not able to attached the file as micro enable so to run the code copy the following code in excel as micro and run it.

Sub Button1_Click()
Dim rng As Range
Dim wks As Worksheet
Dim LastRow As Long
Dim LastRowMul As Long
Dim myRng As Range
Dim myRngMul As Range
Dim cell As Range
Set wks = ActiveSheet

Application.ScreenUpdating = False


With wks
.AutoFilterMode = False
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns(1).Insert
.Range("A9:a" & LastRow).Value = 1

'30 columns + one inserted
Set myRng = .Range("a2:a" & LastRow).Resize(, 31)

Application.DisplayAlerts = False
myRng.Subtotal groupby:=3, Function:=xlSum, totallist:=Array(4, 5), _
Replace:=True, pagebreaks:=False, _
summarybelowdata:=xlSummaryBelow
Application.DisplayAlerts = True

wks.UsedRange.ClearOutline

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("a2:a" & LastRow)

'.Columns(1).Value = .Columns(1).Value

myRng.RemoveSubtotal

myRng.Resize(, 2).AutoFilter field:=1, Criteria1:="1"
myRng.Resize(, 2).AutoFilter field:=2, Criteria1:="*total"

On Error Resume Next
myRng.Offset(1, 0).Resize(myRng.Rows.Count - 1, 1) _
.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0

.AutoFilterMode = False
.Columns(1).Delete
End With

With Intersect(wks.Columns("A"), wks.UsedRange)
    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Set rng = .SpecialCells(xlCellTypeVisible)
    wks.ShowAllData
    rng.EntireRow.Hidden = True
    .SpecialCells(xlCellTypeVisible) = ""
    rng.EntireRow.Hidden = False
End With


'With Intersect(wks.Columns("B"), wks.UsedRange)
 '   .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
 '   Set rng = .SpecialCells(xlCellTypeVisible)
 '   wks.ShowAllData
 '   rng.EntireRow.Hidden = True
 '   .SpecialCells(xlCellTypeVisible) = ""
 '   rng.EntireRow.Hidden = False
'End With


'wks.UsedRange.AutoFormat Format:=xlRangeAutoFormatClassic1, Font:=True, Border:=True, Pattern:=True
Application.ScreenUpdating = True
End Sub

 



 
Subtotal.xlsx