subtotalling records
I have a spreadsheet that I add codes to each morning See example below. What
I currently do is place a list at the bottom of the spreadsheet and then
loop through each record and subtotal based on each diffrent description in
the list. I currently have a static list of codes that get used regulalry.
What I want to do is get rid of the static list and create a dynamic list
based on what is used in the spreadsheet each day. I have included the code
for the static subtotalling.
Here is the spreadsheet
Ref No Debit Reason Desc 2
103312424 - 1,343.61 - 092 15 CM RET
3899862 - 211.20 - 021 06 CM CJX
4000502 - 153.32 - 021 06 CM SUB
4001088 - 137.94 - 092 06 CM CJX
4011306 - 20.00 - 092 06 CM CS
4011448 - 10.00 - 025 A9 CM PJA
4012160 - 90.00 - 092 A9 CM RET
4015083 - 23.96 - 092 06 CM CS
4016002 - 60.00 - 092 A9 CM PJA
I am currently sorting and subtotalling based on the Desc2 field
Here is the static list at the bottom of the spreadsheet
- NA
70.00 PJA
- PJX
- PLA
- POP
- SJA
- SJX
- SLA
- SOP
43.96 GL#81559 CS
- GL#81558 CJ
- GL#81560 LA
- GL#84265 OP
308.11 GL#81640 LT
- CJA
349.14 CJX
- CLA
- COP
- MD
- NB
- EU
- BA
- UCUA
- PPO
- WMT
- NP
- DUP
- UPS
- AR
153.32 SUB
- TKT
- MBI
- OCP
- LL-DSDC
- LL-DTS
- COPY
- LC
1,433.61 RET
- FCA
- AD
- SM
- SO
2,050.03
2,050.03
-
- REF
As you can see I only used a few of these codes.
Here is the code I use to do this
Sub SumCB()
'On Error GoTo SumCB_Err
Dim dblNA As Double
Dim dblPJA As Double
Dim dblPJX As Double
Dim dblPLA As Double
Dim dblPOP As Double
Dim dblSJA As Double
Dim dblSJX As Double
Dim dblSLA As Double
Dim dblSOP As Double
Dim dblCS As Double
Dim dblCJ As Double
Dim dblLA As Double
Dim dblOP As Double
Dim dblCJA As Double
Dim dblCJX As Double
Dim dblCLA As Double
Dim dblCOP As Double
Dim dblMD As Double
Dim dblNB As Double
Dim dblEU As Double
Dim dblBA As Double
Dim dblUCUA As Double
Dim dblWMT As Double
Dim dblNP As Double
Dim dblDUP As Double
Dim dblUPS As Double
Dim dblAR As Double
Dim dblSUB As Double
Dim dblTKT As Double
Dim dblMBI As Double
Dim dblOCP As Double
Dim dblLLDSDC As Double
Dim dblLLDTS As Double
Dim dblCOPY As Double
Dim dblLC As Double
Dim dblRET As Double
'Dim dblLT As Double
Dim dblFCA As Double
Dim dblSM As Double
Dim dblSO As Double
Dim dblAD As Double
Dim dblOTHER As Double
Dim dblREF As Double
Dim A As Worksheet
Dim R As Range
Dim X As Integer
Dim varRng As Variant
Dim Ref As Integer
Dim dblTotal As Double
Dim dblConc As Double
Dim dblPPO As Double
Dim stChkNo As String
Dim stChkDte As String
Set A = Worksheets(1)
Set R = A.UsedRange.Cells
varRng = R.Rows.Count
' Adds up all of the chargebacks by type
Ref = 2
For Each C In Worksheets(1).Range("M2:M" & varRng - 45)
If C = "NA" Then dblNA = dblNA + Range("G" & Ref)
If C = "NA" Then
Rows(Ref).Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
End If
If C = "AR" Then dblAR = dblAR + Range("G" & Ref)
If C = "AR" Then
Rows(Ref).Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
End If
If C = "PJA" Then dblPJA = dblPJA + Range("G" & Ref)
If C = "PJX" Then dblPJX = dblPJX + Range("G" & Ref)
If C = "PLA" Then dblPLA = dblPLA + Range("G" & Ref)
If C = "POP" Then dblPOP = dblPOP + Range("G" & Ref)
If C = "SJA" Then dblSJA = dblSJA + Range("G" & Ref)
If C = "SJX" Then dblSJX = dblSJX + Range("G" & Ref)
If C = "SLA" Then dblSLA = dblSLA + Range("G" & Ref)
If C = "SOP" Then dblSOP = dblSOP + Range("G" & Ref)
If C = "CS" Then dblCS = dblCS + Range("G" & Ref)
If C = "CJ" Then dblCJ = dblCJ + Range("G" & Ref)
If C = "LA" Then dblLA = dblLA + Range("G" & Ref)
If C = "OP" Then dblOP = dblOP + Range("G" & Ref)
If C = "MD" Then dblMD = dblMD + Range("G" & Ref)
If C = "NB" Then dblNB = dblNB + Range("G" & Ref)
If C = "EU" Then dblEU = dblEU + Range("G" & Ref)
If C = "CJA" Then dblCJA = dblCJA + Range("G" & Ref)
If C = "CJX" Then dblCJX = dblCJX + Range("G" & Ref)
If C = "CLA" Then dblCLA = dblCLA + Range("G" & Ref)
If C = "COP" Then dblCOP = dblCOP + Range("G" & Ref)
If C = "BA" Then dblBA = dblBA + Range("G" & Ref)
If C = "UCUA" Then dblUCUA = dblUCUA + Range("G" & Ref)
If C = "UCUA" Then
Rows(Ref).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
If C = "PPO" Then dblPPO = dblPPO + Range("G" & Ref)
If C = "WMT" Then dblWMT = dblWMT + Range("G" & Ref)
If C = "NP" Then dblNP = dblNP + Range("G" & Ref)
If C = "DUP" Then dblDUP = dblDUP + Range("G" & Ref)
If C = "UPS" Then dblUPS = dblUPS + Range("G" & Ref)
If C = "SUB" Then dblSUB = dblSUB + Range("G" & Ref)
If C = "TKT" Then dblTKT = dblTKT + Range("G" & Ref)
If C = "MBI" Then dblMBI = dblMBI + Range("G" & Ref)
If C = "OCP" Then dblOCP = dblOCP + Range("G" & Ref)
If C = "LL-DSDC" Then dblLLDSDC = dblLLDSDC + Range("G" & Ref)
If C = "LL-DTS" Then dblLLDTS = dblLLDTS + Range("G" & Ref)
If C = "COPY" Then dblCOPY = dblCOPY + Range("G" & Ref)
If C = "LC" Then dblLC = dblLC + Range("G" & Ref)
' If C = "LT" Then dblLT = dblLT + Range("G" & Ref)
If C = "RET" Then dblRET = dblRET + Range("G" & Ref)
If C = "FCA" Then dblFCA = dblFCA + Range("G" & Ref)
If C = "SM" Then dblSM = dblSM + Range("G" & Ref)
If C = "SO" Then dblSO = dblSO + Range("G" & Ref)
If C = "AD" Then dblAD = dblAD + Range("G" & Ref)
If C = "AD" Then
Rows(Ref).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End If
If C = "OTHER" Then dblOTHER = dblOTHER + Range("G" & Ref)
If C = "REF" Then dblREF = dblREF + Range("I" & Ref)
Ref = Ref + 1
Next C
' Places the Chargeback totals in their respective fields
Range("I" & varRng - 45).Select
ActiveCell.FormulaR1C1 = dblNA
Range("I" & varRng - 44).Select
ActiveCell.FormulaR1C1 = dblPJA
Range("I" & varRng - 43).Select
ActiveCell.FormulaR1C1 = dblPJX
Range("I" & varRng - 42).Select
ActiveCell.FormulaR1C1 = dblPLA
Range("I" & varRng - 41).Select
ActiveCell.FormulaR1C1 = dblPOP
Range("I" & varRng - 40).Select
ActiveCell.FormulaR1C1 = dblSJA
Range("I" & varRng - 39).Select
ActiveCell.FormulaR1C1 = dblSJX
Range("I" & varRng - 38).Select
ActiveCell.FormulaR1C1 = dblSLA
Range("I" & varRng - 37).Select
ActiveCell.FormulaR1C1 = dblSOP
Range("I" & varRng - 36).Select
ActiveCell.FormulaR1C1 = dblCS
Range("I" & varRng - 35).Select
ActiveCell.FormulaR1C1 = dblCJ
Range("I" & varRng - 34).Select
ActiveCell.FormulaR1C1 = dblLA
Range("I" & varRng - 33).Select
ActiveCell.FormulaR1C1 = dblOP
dblConc = dblCS + dblCJ + dblLA + dblOP
Range("G" & varRng - 32).Select
ActiveCell.FormulaR1C1 = dblConc
Selection.Font.Bold = True
'Range("I" & varRng - 6).Select
'ActiveCell.FormulaR1C1 = dblLT
Range("I" & varRng - 31).Select
ActiveCell.FormulaR1C1 = dblCJA
Range("I" & varRng - 30).Select
ActiveCell.FormulaR1C1 = dblCJX
Range("I" & varRng - 29).Select
ActiveCell.FormulaR1C1 = dblCLA
Range("I" & varRng - 28).Select
ActiveCell.FormulaR1C1 = dblCOP
Range("I" & varRng - 27).Select
ActiveCell.FormulaR1C1 = dblMD
Range("I" & varRng - 26).Select
ActiveCell.FormulaR1C1 = dblNB
Range("I" & varRng - 25).Select
ActiveCell.FormulaR1C1 = dblEU
Range("I" & varRng - 24).Select
ActiveCell.FormulaR1C1 = dblBA
Range("I" & varRng - 23).Select
ActiveCell.FormulaR1C1 = dblUCUA
Range("I" & varRng - 22).Select
ActiveCell.FormulaR1C1 = dblPPO
Range("I" & varRng - 21).Select
ActiveCell.FormulaR1C1 = dblWMT
Range("I" & varRng - 20).Select
ActiveCell.FormulaR1C1 = dblNP
Range("I" & varRng - 19).Select
ActiveCell.FormulaR1C1 = dblDUP
Range("I" & varRng - 18).Select
ActiveCell.FormulaR1C1 = dblUPS
Range("I" & varRng - 17).Select
ActiveCell.FormulaR1C1 = dblAR
Range("I" & varRng - 16).Select
ActiveCell.FormulaR1C1 = dblSUB
Range("I" & varRng - 15).Select
ActiveCell.FormulaR1C1 = dblTKT
Range("I" & varRng - 14).Select
ActiveCell.FormulaR1C1 = dblMBI
Range("I" & varRng - 13).Select
ActiveCell.FormulaR1C1 = dblOCP
Range("I" & varRng - 12).Select
ActiveCell.FormulaR1C1 = dblLLDSDC
Range("I" & varRng - 11).Select
ActiveCell.FormulaR1C1 = dblLLDTS
Range("I" & varRng - 10).Select
ActiveCell.FormulaR1C1 = dblCOPY
Range("I" & varRng - 9).Select
ActiveCell.FormulaR1C1 = dblLC
Range("I" & varRng - 8).Select
ActiveCell.FormulaR1C1 = dblRET
Range("I" & varRng - 7).Select
ActiveCell.FormulaR1C1 = dblFCA
Range("I" & varRng - 6).Select
ActiveCell.FormulaR1C1 = dblAD
Range("I" & varRng - 5).Select
ActiveCell.FormulaR1C1 = dblSM
Range("I" & varRng - 4).Select
ActiveCell.FormulaR1C1 = dblSO
'Totals all of the chargebacks
Range("I" & varRng - 3).Select
ActiveCell.FormulaR1C1 = dblPJA + dblPJX + dblPLA + dblSJA + dblSJX + dblSLA
+ dblUPS _
+ dblCS + dblCJ + dblLA + dblOP + dblMD + dblNB + dblEU + dblBA + dblUCUA +
dblPPO + dblAR + dblSUB _
+ dblTKT + dblMBI + dblOCP + dblLLDSDC + dblLLDTS + dblCOPY + dblLC + dblRET
+ dblFCA + dblAD _
+ dblOTHER + dblCJ3 + dblCS3 + dblLA3 + dblWMT + dblNP + dblDUP + dblNA +
dblCJA + dblCJX + dblCLA _
+ dblSM + dblSO + dblPOP + dblSOP + dblCOP
'The total field from the bottom of the chargebacks
Range("I" & varRng - 2).Select
ActiveCell.FormulaR1C1 = Range("G" & varRng - 50)
'The difference between the Total and Balance fields
Range("I" & varRng - 1).Select
dblTotal = Range("I" & varRng - 3) - Range("I" & varRng - 2)
ActiveCell.FormulaR1C1 = dblTotal
Range("I" & varRng).Select
ActiveCell.FormulaR1C1 = dblREF
' Renames the Sheet
'stChkNo = Range("B2")
'stChkDte = Range("A2")
' Sheets(1).Select
' Sheets(1).Name = stChkNo & " " & Left(stChkDte, 2) & Mid(stChkDte, 4, 2) _
' & Right(stChkDte, 2) & " Adj"
' Creates a copy of the original chargeback sheet
Sheets(1).Select
Sheets(1).Copy After:=Sheets(1)
Range("E2").Select
ActiveWindow.FreezePanes = False
Set A = Worksheets(2)
Set R = A.UsedRange.Cells
varRng = R.Rows.Count
' Sorts the data by Desc and Ref No
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("M2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:=False _
, Orientation:=xlTopToBottom
' Places sub totals below each chargeback group
Range("A1:P" & varRng - 51).Select
Selection.Subtotal GroupBy:=13, Function:=xlSum, TotalList:=Array(7, 9), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'ActiveWindow.SmallScroll Down:=18
'Rows("1:1").Select
Set A = Worksheets(2)
Set R = A.UsedRange.Cells
varRng = R.Rows.Count
' Places the count of each chargeback type below each group
Range("A1:P" & varRng - 50).Select
Selection.Subtotal GroupBy:=13, Function:=xlCount, TotalList:=Array(11), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
Range("E2").Select
ActiveWindow.FreezePanes = True
Set A = Worksheets(2)
Set R = A.UsedRange.Cells
varRng = R.Rows.Count
Range("G" & varRng - 53 & ":J" & varRng - 50).Select
Selection.Font.Bold = True
For X = varRng - 54 To 1 Step -1
'Let Z = X - 1
If Not IsDate(Range("a" & X)) Then
Range("G" & X & ":K" & X).Select
Selection.Font.Bold = True
End If
'Let X = Z - 1
Next X
Columns("I:I").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
If fOSUserName() = "JGaylord" Then
Application.ActivePrinter = "hp deskjet 6122 series on Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"hp deskjet 6122 series on Ne00:", Collate:=True
Else
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End If
If dblConc 0 Then
If fOSUserName() = "JGaylord" Then
Application.ActivePrinter = "hp deskjet 6122 series on Ne00:"
Rows(varRng - 45 & ":" & varRng).Select
Selection.PrintOut Copies:=2, ActivePrinter:= _
"hp deskjet 6122 series on Ne00:", Collate:=True
Else
Rows(varRng - 45 & ":" & varRng).Select
Selection.PrintOut Copies:=2, Collate:=True
End If
End If
Sheets(1).Select
Sheets(1).Copy After:=Sheets(2)
Range("E2").Select
ActiveWindow.FreezePanes = False
Set A = Worksheets(3)
Set R = A.UsedRange.Cells
varRng = R.Rows.Count
' Sorts the data by Desc and Ref No
Rows("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("M2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:=False _
, Orientation:=xlTopToBottom
' Places sub totals below each chargeback group
Range("A1:P" & varRng - 51).Select
Selection.Subtotal GroupBy:=13, Function:=xlSum, TotalList:=Array(7, 9), _
Replace:=True, PageBreaks:=True, SummaryBelowData:=True
'ActiveWindow.SmallScroll Down:=18
'Rows("1:1").Select
Set A = Worksheets(3)
Set R = A.UsedRange.Cells
varRng = R.Rows.Count
' Places the count of each chargeback type below each group
Range("A1:P" & varRng - 50).Select
Selection.Subtotal GroupBy:=13, Function:=xlCount, TotalList:=Array(11), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True
Range("E2").Select
ActiveWindow.FreezePanes = True
Set A = Worksheets(3)
Set R = A.UsedRange.Cells
varRng = R.Rows.Count
Range("G" & varRng - 53 & ":J" & varRng - 50).Select
Selection.Font.Bold = True
For X = varRng - 54 To 1 Step -1
'Let Z = X - 1
If Not IsDate(Range("a" & X)) Then
Range("G" & X & ":K" & X).Select
Selection.Font.Bold = True
End If
'Let X = Z - 1
Next X
Columns("I:I").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
If fOSUserName() = "JGaylord" Then
Application.ActivePrinter = "hp deskjet 6122 series on Ne00:"
Rows(1 & ":" & varRng - 53).Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"hp deskjet 6122 series on Ne00:", Collate:=True
Else
Selection.PrintOut Copies:=1, Collate:=True
ActiveWindow.SelectedSheets.Delete
End If
'SumCB_Exit:
'Exit Sub
'SumCB_Err:
'MsgBox Err.Number
'Resume SumCB_Exit
End Sub
--
Cyberwolf
Finder of Paths, Hunter of Prey
Ghost of the Night, Shadow of Day
The Wolf
|