Not Updating

DS · Jul 6, 2008

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

DS · Jul 6, 2008

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

DS · Jul 6, 2008

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

David Glienna · Jul 6, 2008

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

Marshall Barton · Jul 6, 2008

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

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

DS · Jul 7, 2008

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

Marshall Barton · Jul 7, 2008

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

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.

DS · Jul 7, 2008

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

DS · Jul 7, 2008

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

DS · Jul 7, 2008

Sorry, but can this post. I'm reposting with another approach.
Thanks
DS

Not Updating

DS

DS

DS

David Glienna

Marshall Barton

DS

Marshall Barton

DS

DS

DS