Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Subtotalling | Excel Worksheet Functions | |||
Subtotalling | Excel Programming | |||
Subtotalling | Excel Worksheet Functions | |||
Subtotalling | Excel Worksheet Functions | |||
subtotalling using vba | Excel Programming |