Loop Help

[Stephen Lynch]

My code works but I cannot figure out how to reset the payment amount when I
get to the next account number. I have the following query that I want to
allocate a balance to. For example, the payment is $300, and I need to
allocate to the largest amount first and then finish it off. For example,
my qry is as such.

AccNumber Symbol Balance Payment
1212 TAVFX 125.00 300.00
1212 JEAVX 100.00 300.00
1212 PEOPX 100.00 300.00
4444 TAVFX 400.00 425.00
4444 JEAVX 100.00 300.00
4444 PEOPX 100.00 300.00

So in the above example, on account 1212, $125 would allocated to TAVFX,
$100 to JEAVX, and then only $75, the balance to PEOPX. Then $400 to TAVFX,
then the balance of $25 to JEAVX.

Here is what I have so far. It works but I cannot figure out how to carry
the new balance for a change in account number.

Dim rs As DAO.Recordset
Dim strSQL As String
Dim strContributionAmount As Currency
Dim strDifference As Currency
Dim strAccNumber As String
Dim strSymbol As String
Dim strAllocationAmount As Currency
Dim strMasterID As String
Dim strBalance As Currency


strSQL = "SELECT tblTradesNewStyle.SchwabNumber,
tblTradesNewStyle.Symbol, tblTradesNewStyle.Difference,
tblTradesNewStyle.ContributionAmount, tblTradesNewStyle.MasterID FROM
tblTradesNewStyle;"

Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
strContributionAmount = rs.Fields("ContributionAmount") ' ***** I think
my problem is here! *****

Do While Not rs.EOF
strDifference = rs.Fields("Difference")
strAccNumber = rs.Fields("SchwabNumber")
strSymbol = rs.Fields("Symbol")
strMasterID = rs.Fields("MasterID")

If strContributionAmount <= 0 Then
strAllocationAmount = 0
strBalance = 0
Else
If strContributionAmount >= strDifference Then
strAllocationAmount = strDifference
strBalance = strContributionAmount - strDifference
Else
strAllocationAmount = strContributionAmount
strBalance = 0
End If
End If

If strAllocationAmount > 0 Then
DoCmd.RunSQL "INSERT INTO tblTrades( AccNumber, Symbol, Amount, MasterID)
VALUES('" & strAccNumber & "','" & strSymbol & "', " & strAllocationAmount &
",'" & strMasterID & "')", dbFailOnError
'Carry the balance forward
strContributionAmount = strBalance
rs.MoveNext
Else
strContributionAmount = strBalance
rs.MoveNext
End If

Loop

Exit_Here:
On Error Resume Next
rs.Close
Set rs = Nothing
Exit Sub

ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
Resume Exit_Here



Thanks in advance



Steve

 

[Henk]

Maube I do not understand your question, but I suggest the following:
First of all put this line before the 'Do while not rs.EOF'
strAccNumber = rs.Fields("SchwabNumber")
Then AFTER the line 'Do While not rs.EOF' put this check:
if strAccNumber <> rs.Fields("SchwabNumber") then
strContributionAmount = rs.Fields("ContributionAmount")
end if
Regards
Henk



Stephen Lynch skrev:

 

[Stephen Lynch]

Thanks Henk:

I will try it and see my results. I am new to this and self taught so I
appreciate the help.

Steve

 

[Steve Sanford]

Hi Steve,

This gets a little complicated in that you need two loops.

I changed the prefixs for some of the variables, but I didn't change any of
your calculations or logic. There might be some changes that would streamline
the code.

Right now the recordset select all of the records in table
"tblTradesNewStyle". If these records get deleted every month (or some time
frame), there should be no problems. But if there are records that are
earlier in time, they would be selected every time the code is run. The point
being, you might need to add a where clause to the recordset.

I created the two tables and used the data in your example to check the
code. As far as I can tell, the results are the same as your example.

Here is the code:

(WATCH FOR LINE WRAP)
'-------------------------------
Dim db As DAO.Database
Dim rs As DAO.Recordset

Dim strSQL As String
Dim strSymbol As String
Dim strMasterID As String
Dim strAccNumber As String
Dim strAccNumPrev As String

Dim curContributionAmount As Currency
Dim curAllocationAmount As Currency
Dim curDifference As Currency
Dim curBalance As Currency

Set db = CurrentDb

strSQL = "SELECT tblTradesNewStyle.SchwabNumber, tblTradesNewStyle.Symbol,"
strSQL = strSQL & " tblTradesNewStyle.Difference,
tblTradesNewStyle.ContributionAmount,"
strSQL = strSQL & " tblTradesNewStyle.MasterID"
strSQL = strSQL & " FROM tblTradesNewStyle"
strSQL = strSQL & " ORDER BY tblTradesNewStyle.SchwabNumber,
tblTradesNewStyle.Difference DESC;"

' optional sort order for above recordset
' strSQL = strSQL & " ORDER BY tblTradesNewStyle.SchwabNumber,
tblTradesNewStyle.Difference DESC,"
' strSQL = strSQL & " tblTradesNewStyle.Symbol;"

Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

strAccNumPrev = rs.Fields("SchwabNumber")
strAccNumber = rs.Fields("SchwabNumber")

' outer loop - all records
Do While Not rs.EOF
curContributionAmount = rs.Fields("ContributionAmount")
curDifference = rs.Fields("Difference")
strSymbol = rs.Fields("Symbol")
strMasterID = rs.Fields("MasterID")

' inner loop - Acct records
Do While strAccNumPrev = strAccNumber

If curContributionAmount <= 0 Then
curAllocationAmount = 0
curBalance = 0
Else
' get new data from current record
curDifference = rs.Fields("Difference")
strSymbol = rs.Fields("Symbol")
strMasterID = rs.Fields("MasterID")

If curContributionAmount >= curDifference Then
curAllocationAmount = curDifference
curBalance = curContributionAmount - curDifference
Else
curAllocationAmount = curContributionAmount
curBalance = 0
End If
End If

If curAllocationAmount > 0 Then
'*** changed to Db.Execute
db.Execute "INSERT INTO tblTrades( AccNumber, Symbol, Amount,
MasterID) VALUES('" & strAccNumber & "','" & strSymbol & "', " &
curAllocationAmount & ",'" & strMasterID & "')", dbFailOnError

'Carry the balance forward
curContributionAmount = curBalance
rs.MoveNext
Else
curContributionAmount = curBalance
rs.MoveNext
End If

'check for the end of file. If so exit the loop
If rs.EOF Then
strAccNumber = ""
Exit Do
Else
strAccNumber = rs.Fields("SchwabNumber")
End If
Loop

'check for the end of file. If so exit the loop
If rs.EOF Then
strAccNumber = ""
Exit Do
Else
strAccNumPrev = rs.Fields("SchwabNumber")
End If

Loop

Exit_Here:
On Error Resume Next
rs.Close
Set rs = Nothing
Exit Sub

ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
Resume Exit_Here
'-------------------------------

'End Sub


HTH

 

[Stephen Lynch]

Steve'

You are the man. I will look at it an analyse it. The file is created each
day so I don't think that it will be a problem with earlier dates.

I am going to play with it and see how it come out.

Thanks again.

Steve