Splitting Currency

  • Thread starter Thread starter DS
  • Start date Start date
D

DS

I need to split a currency number into anywhere from 2 to whatever you can
divide it by without going below a whole number.....
How would I do this?

$3.95
Divide by
2 should be $1.97 and $1.98
3 should be $1.31 and $1.32 and $1.32
4 should be .98 and .99 and .99 and .99
etc.

I would return these values to a table, any suggestions on how to do this?
Thanks
DS
 
Here's some code that will split up a currency value into equal portions.
That should be the hard part. I created an array with 10 members, so that may
have to be changed - I don't know what your maximum 'portions' would be.
There's inputbox statements in my code to get the number and the number to be
divided by for testing purposes. It should work.

Private Sub SplitCurrencyValue

Dim myNum As Currency
Dim myNumDivByX As Currency
Dim portion(10) As Currency

myNum = InputBox("enter number to be split up", "enter")
x = InputBox("enter number of portions", "enter")
myNumDivByX = Round(myNum / x, 2)
mynums = vbNullString
If myNumDivByX * x = myNum Then
For i = 1 To x
portion(i) = myNumDivByX
mynums = mynums & portion(i) & vbCrLf
Next i
Else
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
End If
MsgBox myNum & " / " & x & " breaks up into:" & vbCrLf & vbCrLf & mynums

End Sub
 
Thanks Jim..I started playing with it. I need to have it as a Function
since my knowledge does not yet include Subs Here is what I have..
I'm testing it with 3.95 / 3 and I am getting
3.95 / 3
1.32
1.32
1.32

it should be
3.95 / 3
1.31
1.32
1.32

Thanks
DS

Public Function SC(myNum, X)
Dim myNums As String
Dim myNumDivByX As Currency
Dim portion(10) As Currency
Dim i As Integer
Dim leftover As Long
Dim absleftover As Long
Dim addon As Long

myNumDivByX = Round(myNum / X, 2)
myNums = vbNullString
If myNumDivByX * X = myNum Then
For i = 1 To X
portion(i) = myNumDivByX
myNums = myNums & portion(i) & vbCrLf
Next i
Else
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
End If
MsgBox myNum & " / " & X & " breaks up into:" & vbCrLf & vbCrLf & myNums

End Function
 
Thanks Jim..I started playing with it.  I need to have it as a Function
since my knowledge does not yet include Subs  Here is what I have..
I'm testing it with 3.95 / 3 and I am getting
3.95 / 3
1.32
1.32
1.32

it should be
3.95 / 3
1.31
1.32
1.32

Thanks
DS

Public Function SC(myNum, X)
    Dim myNums As String
    Dim myNumDivByX As Currency
    Dim portion(10) As Currency
   Dim i As Integer
   Dim leftover As Long
   Dim absleftover As Long
   Dim addon As Long

   myNumDivByX = Round(myNum / X, 2)
   myNums = vbNullString
   If myNumDivByX * X = myNum Then
      For i = 1 To X
         portion(i) = myNumDivByX
         myNums = myNums & portion(i) & vbCrLf
      Next i
   Else
      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
   End If
   MsgBox myNum & " / " & X & "  breaks up into:" & vbCrLf & vbCrLf& myNums

End Function
Click to expand...

you need to set
SC = myNums

where the final MsgBox function is.
 
Ok James, I almost have it working. Two problems, the first is I'm getting
a Type mismatch on the line
myNums = myNums & portion(i)
And second if I remove portion(1) I only get one result 1.32 as opposed to
the three 1.32 1.32 1.31
Any frther help is appreciated.
Thanks
DS

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

Dim myNums As Currency
Dim myNumDivByX As Currency
Dim portion(25) As Currency
Dim i As Currency
Dim leftover As Currency
Dim absleftover As Currency
Dim addon As Currency

myNumDivByX = Round(myNum / X, 2)
If (myNumDivByX * X) = myNum Then
For i = 1 To X
portion(i) = myNumDivByX
myNums = myNums & portion(i)
Next i
ElseIf (myNumDivByX * X) <> myNum Then
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)
Next i
End If
SC = myNums
End Function
 
myNums should be a string, and I only had it in there so that you could see
what all the values were. I was just concatenating all of the individual
values together, seperated by a vbclrf, so you could clearly see all of the
values. I think the portion array is what you're after - that's what has all
the individual values in it.
 
Back
Top