Not Updating

D

DS

I have one record that I would like to divide into any number of records
that the client chooses as long as it's not a negative number. Everything
works fine except the check total part. Lets say a check is $8.39 and you
want to end up with 4 checks or records in the end, each records total
should be 2.09, 2.10, 2.10, 2.10
What I am getting is the first record becomes 2.10 the second record 2.09
and the third and fourth record are blank. I'm not sure if its in the third
part or the fourth part, my guess is the third. Perhaps it's running to may
times? Any direction is appreciated.
Thanks
DS

For Divider = 1 To Nz(Me.TxtDivideCheck - 1, 0)
Forms!frmPadDivider!TxtDPNewSalesID = Nz(DMax("[ChkTop]", "tblTop"),
0) + 1

'1 GET HIGHEST SALES ID AVAILABLE FROM tblTop
DoCmd.SetWarnings False
TopSQL = "UPDATE tblTop SET [ChkTop] =
Forms!frmPadDivider!TxtDPNewSalesID;"
DoCmd.RunSQL (TopSQL)
DoCmd.SetWarnings True

'2 MAKE NEW RECORD
CurrentDb.Execute "INSERT Into
tblChecksTMP(CheckID,ChkCustomerID,ChkServer,ChkTabID,ChkGuests, " & _
"ChkTypeID,ChkSepCheck,ChkDividedCheck,ChkDivideBy,ChkOldCheckID) "
& _
"VALUES(" & Forms!frmPadDivider!TxtDPNewSalesID & ",1," &
Forms!frmPadDivider!TxtDPServer & ", " & _
"" & Forms!frmPadDivider!TxtDPTableNumber & "," & 1 & "," & 1 & ","
& 0 & ", " & _
"" & -1 & "," & Forms!frmPadDivider!TxtDivideCheck & ", " & _
"" & Forms!frmPadDivider!TxtDPOldSalesID & ")"

'3 MAKE NEW TOTA:L
Dim myNumDivByX As Currency
Dim myNums As String
Dim i As Currency
Dim leftover As Currency
Dim absleftover As Currency
Dim addon As Currency
Dim portion(100) As Currency
myNumDivByX = Round(Me.TxtDPTotal / Me.TxtDivideCheck, 2)

If (myNumDivByX * Me.TxtDivideCheck) = Me.TxtDPTotal Then
For i = 1 To Me.TxtDivideCheck
portion(i) = myNumDivByX
myNums = myNums & portion(i)
Next i
ElseIf (myNumDivByX * Me.TxtDivideCheck) <> Me.TxtDPTotal Then
leftover = Me.TxtDPTotal - (myNumDivByX * Me.TxtDivideCheck)
absleftover = Abs(leftover)
If leftover < 0 Then
addon = -0.01
Else
addon = 0.01
End If

If i <= absleftover * 100 Then
portion(i) = myNumDivByX + addon
Else
portion(i) = myNumDivByX
End If
myNums = myNums & portion(i)

End If
Me.TxtNewTotal = myNums

'4 UPDATE Check Total
If Me.TxtDPOldSalesID = Me.TxtDPNewSalesID Then
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPOldSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
Else
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPNewSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
End If
Next Divider
 
D

DS

This is at least filling in the chck totals, the only problem is...
instead of being 2.09, 2.10, 2.10, 2.10
its 2.10, 2.09, 2.09, 2.09
DS

Dim myNumDivByX As Currency
Dim myNums As String
Dim i As Currency
Dim leftover As Currency
Dim absleftover As Currency
Dim addon As Currency
Dim portion(100) As Currency
myNumDivByX = Round(Me.TxtDPTotal / Me.TxtDivideCheck, 2)

If (myNumDivByX * Me.TxtDivideCheck) = Me.TxtDPTotal Then
'For i = 1 To Me.TxtDivideCheck
portion(i) = myNumDivByX
Me.TxtNewTotal = myNums & portion(i)
'Next i

'UPDATE Check Total
If Me.TxtDPOldSalesID = Me.TxtDPNewSalesID Then
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPOldSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
Else
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPNewSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
End If
ElseIf (myNumDivByX * Me.TxtDivideCheck) <> Me.TxtDPTotal Then
leftover = Me.TxtDPTotal - (myNumDivByX * Me.TxtDivideCheck)
absleftover = Abs(leftover)
MsgBox absleftover
If leftover < 0 Then
addon = -0.01
Else
addon = 0.01
End If

If i <= absleftover * 100 Then
portion(i) = myNumDivByX + addon
Else
portion(i) = myNumDivByX
End If
Me.TxtNewTotal = myNums & portion(i)

'UPDATE Check Total
If Me.TxtDPOldSalesID = Me.TxtDPNewSalesID Then
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPOldSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
Else
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPNewSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
End If
End If
Next Divider
 
D

DS

The problem is that the code is adding .01 to all of the records instead of
minus on the first or whatever then minus after that. any suggestions on
how to fix this?
Thanks
DS
 
D

David Glienna

that's known as Banker's Rounding, which is the preferred method of dealing
with currency. Currency is valid to 4 decimal points.
 
M

Marshall Barton

DS said:
This is at least filling in the chck totals, the only problem is...
instead of being 2.09, 2.10, 2.10, 2.10
its 2.10, 2.09, 2.09, 2.09
DS

Dim myNumDivByX As Currency
Dim myNums As String
Dim i As Currency
Dim leftover As Currency
Dim absleftover As Currency
Dim addon As Currency
Dim portion(100) As Currency
myNumDivByX = Round(Me.TxtDPTotal / Me.TxtDivideCheck, 2)

If (myNumDivByX * Me.TxtDivideCheck) = Me.TxtDPTotal Then
'For i = 1 To Me.TxtDivideCheck
portion(i) = myNumDivByX
Me.TxtNewTotal = myNums & portion(i)
'Next i

'UPDATE Check Total
If Me.TxtDPOldSalesID = Me.TxtDPNewSalesID Then
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPOldSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
Else
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPNewSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
End If
ElseIf (myNumDivByX * Me.TxtDivideCheck) <> Me.TxtDPTotal Then
leftover = Me.TxtDPTotal - (myNumDivByX * Me.TxtDivideCheck)
absleftover = Abs(leftover)
MsgBox absleftover
If leftover < 0 Then
addon = -0.01
Else
addon = 0.01
End If

If i <= absleftover * 100 Then
portion(i) = myNumDivByX + addon
Else
portion(i) = myNumDivByX
End If
Me.TxtNewTotal = myNums & portion(i)

'UPDATE Check Total
If Me.TxtDPOldSalesID = Me.TxtDPNewSalesID Then
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPOldSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
Else
DoCmd.SetWarnings False
CheckSQL = "UPDATE tblChecksTMP SET
[ChkTotal]=Forms!frmPadDivider!TxtNewTotal " & _
"WHERE tblChecksTMP.[CheckID] =
Forms!frmPadDivider!TxtDPNewSalesID;"
DoCmd.RunSQL (CheckSQL)
DoCmd.SetWarnings True
End If
End If
Next Divider
Click to expand...


Sorry, but I can't figure out what that code is doing.
OTOH, I don't see why a few cents makes a difference to the
order of the portions. If that's acceptable, the only code
needed could be:

PortionAll = Round(Me.TxtDPTotal / Me.TxtDivideCheck, 2)
PortionLast = Me.TxtDPTotal - (Me.TxtDivideCheck - 1) *
PortionAll
 
D

DS

Marsh I stripped the code down and away, perhaps it will be clearer...
In this case I'm dividing 8.39 by 4 so I should get
2.09, 2.10, 2.10, 2.10 this adds up to 8.39
I can't use the expression because sometimes it's more than one record that
has minus .01 on a divided number
I think the problem is where I noted, it has to do with the <0

Here is the code further stripped...

Thanks
DS

Dim myNumDivByX As Currency
Dim myNums As String
Dim i As Currency
Dim leftover As Currency
Dim absleftover As Currency
Dim addon As Currency
Dim portion(100) As Currency
myNumDivByX = Round(Me.TxtDPTotal / Me.TxtDivideCheck, 2)

leftover = Me.TxtDPTotal - (myNumDivByX * Me.TxtDivideCheck)
absleftover = Abs(leftover)
If leftover < 0 Then 'I think this is the problem....Is .0016 or -.0016
less than zero?
addon = -0.01
Else
addon = 0.01
End If

If i <= absleftover * 100 Then
portion(i) = myNumDivByX + addon
Else
portion(i) = myNumDivByX
End If

Me.TxtNewTotal = myNums & portion(i)

'UPDATE Check Total

Next Divider
 
M

Marshall Barton

DS said:
Marsh I stripped the code down and away, perhaps it will be clearer...
In this case I'm dividing 8.39 by 4 so I should get
2.09, 2.10, 2.10, 2.10 this adds up to 8.39
I can't use the expression because sometimes it's more than one record that
has minus .01 on a divided number
I think the problem is where I noted, it has to do with the <0

Here is the code further stripped...

Dim myNumDivByX As Currency
Dim myNums As String
Dim i As Currency
Dim leftover As Currency
Dim absleftover As Currency
Dim addon As Currency
Dim portion(100) As Currency
myNumDivByX = Round(Me.TxtDPTotal / Me.TxtDivideCheck, 2)

leftover = Me.TxtDPTotal - (myNumDivByX * Me.TxtDivideCheck)
absleftover = Abs(leftover)
If leftover < 0 Then 'I think this is the problem....Is .0016 or -.0016
less than zero?
addon = -0.01
Else
addon = 0.01
End If

If i <= absleftover * 100 Then
portion(i) = myNumDivByX + addon
Else
portion(i) = myNumDivByX
End If

Me.TxtNewTotal = myNums & portion(i)

'UPDATE Check Total

Next Divider
Click to expand...


I think the left over should be:

leftover = Me.TxtDPTotal - (myNumDivByX *
(Me.TxtDivideCheck - 1))

Then, if you must, adjust from there.

You stripped the For statement so I can't tell what effect
it will have.
 
D

DS

It actually return a null value or a blank space. I'm going to play further
and get back to you.
Thanks
DS
 
D

DS

Marsh I've been playing all night with this and I'm starting to go round in
circles...
I need to update a table with the result of this function, problem is that
it returns several values and each value needs o be assigned. How do I
place each value in the table? Do I kill it as a function and do something
else or ....?
Any help is appreciated.
Thanks
DS

Public Function SC(myNum As Currency, X As Integer)

Dim myNums As String
Dim myNumDivByX As Currency
Dim portion(100) As Currency
Dim i As Currency
Dim leftover As Currency
Dim absleftover As Currency
Dim addon As Currency
myNumDivByX = Round(myNum / X, 2)

leftover = myNum - (myNumDivByX * X)
absleftover = Abs(leftover)
If leftover < 0 Then
addon = -0.01
Else
addon = 0.01
End If
For i = 1 To X
If i <= absleftover * 100 Then
portion(i) = myNumDivByX + addon
Else
portion(i) = myNumDivByX
End If
myNums = myNums & portion(i) & vbCrLf
Next i
SC = myNums
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Correct Syntax 2
More Correct Syntax 5
Wont Stop 6
A Loop in a Loop 3
Docmd.Setwarning False Not Working 6
SetWarning False not working 0

Top