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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
subtotalling records
Cyberwolf, If i'm reading you right (the column layout gets distorted upon posting) the code seems to be excessive for what you are trying to do. Would any of the following be sufficient for your needs? 1) Sort table (spreadsheet) by Desc2 then apply sub-totals or 2) Create unique list from Desc2 then apply SumIf formula Both the above can be easily achieved either by using Excels built in functionality or VBA code. If any of the above meets your need let me know and l can probably give you some code Regards Michael Beckinsale |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
subtotalling records
I know my code was very bulky. The 2nd option you mentioned seams the
direction I want to go in. If you can give me something to look at I could go from there. I am already sorting and subtotalling by desc 2. This is done at the bottom of the VBA code. - Cyberwolf Finder of Paths, Hunter of Prey Ghost of the Night, Shadow of Day The Wolf "michael.beckinsale" wrote: Cyberwolf, If i'm reading you right (the column layout gets distorted upon posting) the code seems to be excessive for what you are trying to do. Would any of the following be sufficient for your needs? 1) Sort table (spreadsheet) by Desc2 then apply sub-totals or 2) Create unique list from Desc2 then apply SumIf formula Both the above can be easily achieved either by using Excels built in functionality or VBA code. If any of the above meets your need let me know and l can probably give you some code Regards Michael Beckinsale |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
subtotalling records
Assume the Desc column is column D ( 4th column). Assume you want the list
of uniques in A500, Then: Sub MakeUniqueList() Dim rng as Range set rng = Range(cells(1,4),cells(1,4).End(xldown)) rng.AdvancedFilterAction:=xlFilterCopy, _ CopyToRange:=Range("A500"), _ Unique:=True end Sub -- Regards, Tom Ogilvy "Cyberwolf" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
subtotalling records
Tom, You beat me to it! Regards Michael beckinsale |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
subtotalling records
This is not giving me truly unique values. I made sure there were no spaces
or hidden characters, and it is repeating the top most value. Here is my code so far I had to chenge the range to accomodate my true spreadsheet. and I sorted this on Desc2 column then ran your code Sub MakeUniqueList() Dim rng As Range 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 Set rng = Range(Cells(2, 13), Cells(2, 13).End(xlDown)) rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("L15"), Unique:=True End Sub and it gave me this CJX CJX CS PJA RET SUB from this info Desc 2 CJX CJX CS CS PJA PJA RET RET SUB I actually went it and retyped every row to make sure there were not any other characters. -- Cyberwolf Finder of Paths, Hunter of Prey Ghost of the Night, Shadow of Day The Wolf "Tom Ogilvy" wrote: Assume the Desc column is column D ( 4th column). Assume you want the list of uniques in A500, Then: Sub MakeUniqueList() Dim rng as Range set rng = Range(cells(1,4),cells(1,4).End(xldown)) rng.AdvancedFilterAction:=xlFilterCopy, _ CopyToRange:=Range("A500"), _ Unique:=True end Sub -- Regards, Tom Ogilvy "Cyberwolf" wrote: 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
subtotalling records
Cyberwolf, This function requires a header therefore it always thinks the 1st row is the header. Make sure you have a header in the column and use that row as the 1st row in the range. Regards Michael Beckinsale |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
subtotalling records
As Michael stated - Advanced filter assumes a header in the first cell.
Sub MakeUniqueList() Dim rng As Range 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 Set rng = Range(Cells(1, 13), Cells(1, 13).End(xlDown)) rng.AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("L15"), _ Unique:=True ' remove the copied header Range("L15").Delete End Sub -- Regards, Tom Ogilvy "Cyberwolf" wrote: This is not giving me truly unique values. I made sure there were no spaces or hidden characters, and it is repeating the top most value. Here is my code so far I had to chenge the range to accomodate my true spreadsheet. and I sorted this on Desc2 column then ran your code Sub MakeUniqueList() Dim rng As Range 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 Set rng = Range(Cells(2, 13), Cells(2, 13).End(xlDown)) rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("L15"), Unique:=True End Sub and it gave me this CJX CJX CS PJA RET SUB from this info Desc 2 CJX CJX CS CS PJA PJA RET RET SUB I actually went it and retyped every row to make sure there were not any other characters. -- Cyberwolf Finder of Paths, Hunter of Prey Ghost of the Night, Shadow of Day The Wolf "Tom Ogilvy" wrote: Assume the Desc column is column D ( 4th column). Assume you want the list of uniques in A500, Then: Sub MakeUniqueList() Dim rng as Range set rng = Range(cells(1,4),cells(1,4).End(xldown)) rng.AdvancedFilterAction:=xlFilterCopy, _ CopyToRange:=Range("A500"), _ Unique:=True end Sub -- Regards, Tom Ogilvy "Cyberwolf" wrote: 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 |
Reply |
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 |