Conditional Running Totals 1

[Ebes1099]

I'm trying to figure out something in SQL but thought I might be able to use a VBA macro (in excel or access) to solve this problem so I am posting this question in here as well.

I'm thinking there might be a way to loop through in a VBA macro and write in formulas in the calculated columns to get what I want. I start with the first 3 columns in my example and the next 4 would all be calculations.

I've put an example below but I'll try and explain it in words too. I start with a Billed amount. 100% of that goes into the member bucket until the Member Cumulative cost hits Limit 1. In this case limit 1 is $750. Between Limit 1 and Limit 2 ($1500), 20% of billed goes into Member and 80% of billed goes into Plan. Once the Member Cumulative cost hits Limit 2, 100% of Billed goes into Plan.

Here's an example
Month -- ID --- Billed -- Plan_Month -- Plan_Yr_Ttl -- Mbr_Month -- Mbr_Yr_Ttl
Jan ---- 100 --- 500 --------- 0 ------------ 0 ----------- 500 --------- 500
Feb ---- 100 --- 300 -------- 240 ----------- 240 --------- 60 --------- 560
Mar ---- 100 --- 400 -------- 320 ----------- 560 --------- 80 --------- 640
Apr ---- 100 --- 800 -------- 690 ----------- 1250 --------- 110 --------- 750 *Limit 1 is $750 - 20% would have hit 800 so 50 subtracted and added to Plan
May ---- 100 --- 1000 ------- 800 ----------- 2050 --------- 200 --------- 950
Jun ---- 100 --- 600 -------- 480 ----------- 2530 --------- 120 --------- 1070
Jul ---- 100 ---- 700 -------- 560 ----------- 3090 --------- 140 --------- 1210
Aug ---- 100 --- 800 -------- 640 ----------- 3730 --------- 160 --------- 1370
Sep ---- 100 --- 800 -------- 670 ----------- 4400 --------- 160 --------- 1500 *Limit 2 is $1500, 20% would have hit $1550 so 30 subtracted and added to Plan
Oct ---- 100 --- 200 -------- 200 ----------- 4600 --------- 0 --------- 1500
Nov ---- 100 ---- 0 ---------- 0 ------------ 4600 --------- 0 --------- 1500
Dec ---- 100 --- 100 -------- 100 ----------- 4700 --------- 0 --------- 1500

 

[RonRepp]

Personally, I'd use MSQuery to get your results into XL, and do your parsing in SQL. Something like this: (BTW, this is very old code, so I'm sure if you're using a newer version of XL you'll have to tweak it)

Public XL As New Excel.Application
Public DOW As Integer
Public AB As String
Public Client As String
Public sClient As String
Public sPath As String
Public sName As String
Public sCamp As String
Public ActClient As Integer
Public Pid As String
Public IStatus As String
Public iType As Integer
Public LOut As Integer
Public D1 As Integer
Public D2 As Integer
Public G1 As String
Public G2 As String
Public G3 As String
Public strDate As String
Public M As String
Public D As String
Public Y As String
Public sCon As String
Public sDate As Date
Public eDate As Date
Public GB As Integer
Public strD As String

Public Sub Main()
        M = Month(Now)
        D = Day(Now)
        Y = Year(Now)
        If CInt(M) < 10 Then
            M = "0" & M
        End If
        If CInt(D) < 10 Then
            D = "0" & D
        End If
        strDate = M & D & Y
        sCon = "Provider=SQLOLEDB.1;Password=PWord;" & _
           "Persist Security Info=True;" & _
           "User ID=UserID;Initial Catalog=InitCatalog;Data Source=DataSourceName"
           
        OpenXL
        OpenRecordset
        XL.Quit
        Set XL = Nothing
End Sub

Public Sub OpenXL()
        Set XL = New Excel.Application
        XL.Visible = True
    End Sub 'OpenXL

    Public Sub SaveXL()
        XL.DisplayAlerts = False
        FileName = sPath & AB & "_" & sName & "_" & strDate & ".xls"
        XL.ActiveWorkbook.SaveAs (FileName)
        XL.ActiveWorkbook.Close (False)
        XL.DisplayAlerts = True
    End Sub 'SaveXL

Public Sub ChangeGroup()
    XL.Range("A3").Value = G1
    XL.Range("B3").Value = G2
    XL.Range("C3").Value = G3
End Sub

Public Sub RunQueries(ByVal SQL_String As String)

XL.Workbooks.Add

With XL.ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DRIVER=SQL Server;SERVER=ServerName;UID=UIDName;APP=Microsoft® Query;WSID=CMORRIS;DATABASE=DatabaseName;Trusted_Connection=Yes" _
        , Destination:=XL.Range("A3"))
        .CommandText = SQL_String
        .Name = "CashFlow"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With

End Sub

Public Sub RunSalesTax()
sDate = Date - D1
eDate = Date - D2

Dim SQL As String
Dim Pos As Integer

    SQL = "RPT_TaxByState "
    SQL = SQL & " '" & sDate & " 00:00:00',"
    SQL = SQL & " '" & eDate & " 23:59:59',"
    SQL = SQL & " '-1',"
    SQL = SQL & " '" & sClient & "', "
    SQL = SQL & " 1, "
    SQL = SQL & " '-1', "
    SQL = SQL & " 1, "
    SQL = SQL & " '-1'"
    Debug.Print SQL
    
RunQueries SQL
End Sub
Public Sub OpenRecordset()
    Dim Con As ADODB.Connection
    Set Con = New ADODB.Connection
    Dim RS As ADODB.Recordset
    Set RS = New ADODB.Recordset
    Dim SQL As String
    Con.ConnectionString = sCon
    Con.Open sCon
    SQL = GetSQL
    RS.Open SQL, Con, adOpenDynamic, adLockBatchOptimistic, adCmdText
    Do While Not RS.EOF
        Client = RS("Client").Value
        D1 = RS("Date1").Value
        If DOW = 2 Then
            If D1 = 1 Then D1 = 3
        End If
        
        D2 = RS("Date2").Value
        sClient = RS("strClient").Value
        ActClient = RS("ClientActive").Value
        sCamp = RS("strCampaign").Value
        Pid = RS("ProdGroupID").Value
        IStatus = RS("ItemStatus").Value
        iType = RS("intType").Value
        LOut = RS("Layout").Value
        sPath = RS("SavePath").Value
        sName = RS("SaveName").Value
        AB = RS("ClientAb").Value
        G1 = RS("Group1").Value
        G2 = RS("Group2").Value
        G3 = RS("Group3").Value
        
        RunSalesTax
        AddHeader
        FormatHeaders
        Landscape
        Totals
        FormatTotals
        FormatColumns
        XL.Range("A1").Select
        SaveXL
        
    RS.MoveNext
    
    Loop
    RS.Close
    Set RS = Nothing
    Con.Close
    Set Con = Nothing

End Sub


Public Function GetSQL() As String
Dim SQL As String
DOW = Weekday(Now)

SQL = "SELECT Client.Client, "
SQL = SQL & " SalesTaxTemplate.Date1, "
SQL = SQL & " SalesTaxTemplate.Date2, "
SQL = SQL & " SalesTaxTemplate.strClient, "
SQL = SQL & " SalesTaxTemplate.strCampaign, "
SQL = SQL & " SalesTaxTemplate.ClientActive, "
SQL = SQL & " SalesTaxTemplate.ProdGroupID,"
SQL = SQL & " SalesTaxTemplate.ItemStatus, "
SQL = SQL & " SalesTaxTemplate.intType, "
SQL = SQL & " SalesTaxTemplate.Layout, "
SQL = SQL & " SalesTaxTemplate.SavePath,"
SQL = SQL & " SalesTaxTemplate.SaveName, "
SQL = SQL & " SalesTaxTemplate.ClientAb, "
SQL = SQL & " SalesTaxTemplate.Group1, "
SQL = SQL & " SalesTaxTemplate.Group2,"
SQL = SQL & " SalesTaxTemplate.Group3, "
SQL = SQL & " SalesTaxTemplate.IsMonthly, "
SQL = SQL & " SalesTaxTemplate.DayOfMonth "
SQL = SQL & " FROM Client INNER JOIN"
SQL = SQL & " SalesTaxTemplate ON Client.ClientID = SalesTaxTemplate.ClientID"

Select Case DOW
    Case 2

        SQL = SQL & " Where (SalesTaxTemplate.M = 1)"
    Case 3
        SQL = SQL & " Where (SalesTaxTemplate.T = 1)"
    Case 4
        SQL = SQL & " Where (SalesTaxTemplate.W = 1)"
    Case 5
        SQL = SQL & " Where (SalesTaxTemplate.TH = 1)"
    Case 6
        SQL = SQL & " Where (SalesTaxTemplate.F = 1)"
        
End Select

GetSQL = SQL

End Function
Sub AddHeader()

    XL.Range("A1:G1").Select
    With XL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
        .Font.Bold = True
    End With
    XL.Selection.Merge
   XL.Range("A1:G1").Select
        
    XL.ActiveCell.Value = Client & " Report " & sDate & " to " & eDate
    XL.Range("A2").Select
End Sub

Public Sub Landscape()

    On Error Resume Next
    With XL.ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$4"
        .PrintTitleColumns = ""
    End With
    XL.ActiveSheet.PageSetup.PrintArea = ""
    With XL.ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.75)
        .RightMargin = Application.InchesToPoints(0.75)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(1)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
    
    XL.ActiveWindow.View = xlPageBreakPreview
    XL.ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    XL.ActiveWindow.View = xlNormalView
End Sub

Public Sub FormatHeaders()
    XL.Rows("2:2").Select
    XL.Selection.Insert Shift:=xlDown
    XL.Range("A2:G2").Select
    With XL.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    XL.Selection.Merge
    XL.Rows("2:2").RowHeight = 27.75
    XL.Range("A1:G2").Select
    With XL.Selection.Interior
        .ColorIndex = 49
        .Pattern = xlSolid
    End With
    XL.Selection.Font.ColorIndex = 2
    XL.Range("A2:G2").Select
    With XL.Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    XL.ActiveCell.Value = "Sales Tax by State Report"
    XL.Range("A1:G2").Select
    With XL.Selection.Font
        .Name = "Times New Roman"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 2
    End With
    XL.Range("A2:G2").Select
    With XL.Selection.Font
        .Name = "Times New Roman"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 2
    End With
    XL.Range("A4").Value = "Country"
    XL.Range("B4").Value = "State"
    XL.Range("C4").Value = "OrderID"
    XL.Range("D4").Value = "Item Price"
    XL.Range("E4").Value = "Shipping"
    XL.Range("F4").Value = "Tax"
    XL.Range("G4").Value = "Fed Tax"
    XL.Range("H4").Value = "Campaign"
    XL.Range("I4").Value = "Client"
    XL.Range("A1").Select
End Sub
Function FindLastRow() As Integer
    LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    LastRow = LastRow + 1
    FindLastRow = LastRow

End Function

Public Sub Totals()
    Dim R As Integer
    XL.Cells.Select
    XL.Cells.EntireColumn.AutoFit
    R = FindLastRow
    XL.Range("A" & R).Activate
    If XL.ActiveCell.Address = "$A$5" Then
        XL.ActiveCell.Value = "Totals"
        XL.ActiveCell.Offset(0, 3).Value = 0
        XL.ActiveCell.Offset(0, 4).Value = 0
        XL.ActiveCell.Offset(0, 5).Value = 0
        XL.ActiveCell.Offset(0, 6).Value = 0
        Exit Sub
    End If
    
    XL.ActiveCell.Value = "Totals"
    XL.ActiveCell.Offset(0, 3).Formula = "=SUM(D5:" & XL.ActiveCell.Offset(-1, 3).Address & ")"
    XL.ActiveCell.Offset(0, 4).Formula = "=SUM(E5:" & XL.ActiveCell.Offset(-1, 4).Address & ")"
    XL.ActiveCell.Offset(0, 5).Formula = "=SUM(F5:" & XL.ActiveCell.Offset(-1, 5).Address & ")"
    XL.ActiveCell.Offset(0, 6).Formula = "=SUM(G5:" & XL.ActiveCell.Offset(-1, 6).Address & ")"
    XL.Range("A1").Select
End Sub

Sub FormatTotals()
Dim R As Integer
R = FindLastRow
R = R - 1
    XL.Range("A4:G4").Select
    With XL.Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    XL.Range("A" & R & ":G" & R).Select
    With XL.Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    XL.Selection.Font.Bold = True
End Sub
Sub FormatColumns()
    'XL.Columns("H:I").Select
    'XL.Selection.Delete Shift:=xlToLeft
    XL.Range("H4").Value = ""
    XL.Range("I4").Value = ""
    XL.Columns("A:G").Select
    XL.Selection.ColumnWidth = 11
    XL.Columns("D:G").Select
    XL.Selection.NumberFormat = "$#,##0.00"
End Sub

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors

http://www.repproductions.net

 

[SkipVought]

Hi,

I think you could do this on a sheet with formulas, using a table of limits and percents to lookup via MATCH() with a 1 or -1 value in the 3rd argument, I forget what that is formally called, and INDEX() to return a value from the appropriate column. Pretty simple IMNSHO.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Ebes1099]

Skip,

I don't think I'm following what you are trying to say. Can you elaborate a little more?

I'm starting with the columns Month, ID and Billed. I want MbrMonth = Billed up until Limit1. Then I want it to equal Billed*Val up until Limit2. Then it should equal 0 after that.

Plan works the opposite. It is 0 up until Limit1, Billed*(1-Val) up until Limit2 then Billed after Limit2.

 

[SkipVought]

I am further confused!

I want MbrMonth = Billed up until Limit1

Yet that is not what I see in your example.
[tt]
Month -- ID --- Billed -- Plan_Month -- Plan_Yr_Ttl -- Mbr_Month -- Mbr_Yr_Ttl
Jan ---- 100 --- 500 --------- 0 ------------ 0 ----------- 500 --------- 500
Feb ---- 100 --- [highlight]300[/highlight] -------- 240 ----------- 240 --------- [highlight]60[/highlight] --------- 560
[/tt]
What am I missing?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

according to your most recently stated spec, this is what I get in the essential fields...
[tt]
A C D F G
Month Billed Plan_Month Mbr_Month
Jan 500 0 500 500
Feb 300 0 300 800
Mar 400 320 80 880
Apr 800 640 160 1040
May 1000 800 200 1240
Jun 600 480 120 1360
Jul 700 560 140 1500
Aug 800 0 800 2300
Sep 800 0 800 3100
Oct 200 0 200 3300
Nov 0 0 0 3300
Dec 100 0 100 3400
[/tt]
Using this lookup tqble
[tt]
limit pct
0 1
750 0.2
1500 1
[/tt]
and this formula in mbr month in
[tt]
F2: =INDEX(pct,MATCH(G1,limit,1),1)*Billed
[/tt]
then the pln value is simply =Billed-Mbr_Month


...IF that's what you really stated.


Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

This might be a better presentation

A       C        D         F         G
Month Billed Plan_Month Mbr_Month 
Jan      500          0       500   500
Feb      300          0       300   800
Mar      400        320        80   880
Apr      800        640       160  1040
May     1000        800       200  1240
Jun      600        480       120  1360
Jul      700        560       140  1500
Aug      800          0       800  2300
Sep      800          0       800  3100
Oct      200          0       200  3300
Nov        0          0         0  3300
Dec      100          0       100  3400

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

and

Using this lookup table

limit  pct
    0  1
  750  0.2
 1500  1

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Ebes1099]

I see where you're going with this now. It makes sense to me. Very clever.

One question, what do you have for a formula in Column G?

You get a circular reference warning if I try and sum up Column F.

 

[SkipVought]

okay, think of the process and the logic.

calculate a value for Mbr_Month base on a cumulative sum for Mbr_Month, which are the values in column G. So what is the cumulative value to base this on in month 1? Is it not ZERO? We have no cumulative value UNTIL we calculate the Mbr_Month value base on the pre-existing cumulative value. So for month 1 the pre-existing cumulative value is G1 with is ZERO.

This is why the cancluation in F2, references G1, the PRIOR month's cumulative value. You cannot reference G2 because G2 includes F2, the Mbr_Month value: hence a circular reference.

It's a chicken or the egg dilema.

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[SkipVought]

Sorry I never really answered your question.
[tt]
G2: =G1+Mbr_Month
[/tt]

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]