VBA Add comparative columns between headers

[XfortunaX]

Hi Forum!

I have the same reptitive task everymorning. In Excel 2010, I have figured out the sort but cannot get my head around adding comparative columns. I am looking to add two columns between different headers. The first column would be titled '$ Change' and contain a formula subtracting column 1 from column 2. The second column would be titled '% Change' and contain another formula.

This is what it looks like now:



This is what I am hoping for it to look like:



I would like to add the peice above onto the bottom of what I already have:
Option Explicit
Sub SortMonths()

Dim FirstDate As String
Dim LastDate As String
Dim LastColumn As Integer

FirstDate = Range("C1")
LastDate = Range("C1").End(xlToRight).Offset(0, -1)

'Rename the current tab
Sheets(1).Name = "CustomerSummary_" & FirstDate & "_" & LastDate

'Move 'Total' over one cell
Selection.End(xlDown).Select
Selection.Cut
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste

'Name Column B
Range("B1") = "Manufacturer"
Range("C1").Copy
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

'Name the Range of data
Range("C:C").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Name = "RNG"

'Sort the columns
Range("RNG").Select
ActiveWorkbook.Worksheets("CustomerSummary_" & FirstDate & "_" & LastDate).Sort.SortFields.Clear
ActiveWorkbook.Worksheets("CustomerSummary_" & FirstDate & "_" & LastDate).Sort.SortFields.Add Key:=Range("C1:Y1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("CustomerSummary_" & FirstDate & "_" & LastDate).Sort
.SetRange Range("RNG")
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With

'Delete AR Adjustments
With ActiveSheet
.AutoFilterMode = False
With Range("B1", Range("B" & Rows.Count).End(xlUp))
.AutoFilter 1, "AR Adjustment CPA*"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With

End Sub

Any help would be awesome.

Thanks,

Tuna