Using Excel's Rounddown in a UDF rounds 1 to 0 - vba

To make a long story short, the place where I work measures time by quadrants of a clock. For instance, 1.1 is an hour and 0-15 minutes, 1.2 is an hour and 15-30 minutes, and 1.3 is an hour and 30-45 minutes. There is no 1.4 because 1.4 is of course equal to 2.
I wanted to make an excel sheet that would automatically add my time under this system, so I wrote this UDF to convert the times by separating the decimal values and multiplying by 2.5 to get a normal decimal value (.1 = .25, .2 = .5, .3 = .75) and then dividing by 2.5 at the end to convert back to my employer's format. I'm aware that it can be done using excel's existing formulas, but is is kind of messy and to be honest I'm too stubborn to let this go now.
If you look at the screenshot below you'll see that the function works for all of the columns except the final weekly total column for some reason which displays 39.4 instead of 40 (again the two values are technically equivalent, but the program is not converting the .4 into a 1 for some reason).
http://i.imgur.com/yxOvlkP.png
Here is the code in it's entirety. The problem seems to occur when the remainder becomes equal to exactly 1 (for simplicity just imagine that two values ending .2 are entered) and then is rounded to zero somehow at the end.
Function newMath(week As Range) As Double
Dim time As Variant
Dim remainder As Double
Dim wholeTime As Double
remainder = 0
wholeTime = 0
For Each time In week
remainder = remainder + ((time - WorksheetFunction.RoundDown(time, 0)) * 2.5) 'Separate and sum up decimal values
wholeTime = wholeTime + WorksheetFunction.RoundDown(time, 0) 'Separate and sum up whole hours
Next time
'Problem occurs at this point when remainder = 1
'WorksheetFunction.RoundDown(remainder, 0) will equal 0 below even when 1 should round down to 1
wholeTime = wholeTime + WorksheetFunction.RoundDown(remainder, 0) 'Add the whole remainder hours to whole time
remainder = (remainder - WorksheetFunction.RoundDown(remainder, 0)) / 2.5 'Get decimal value of remainder and convert back to quadrant
newMath = wholeTime + remainder
End Function
Somehow when the remainder equals exactly 1 excel's rounddown function seems to round it to 0.
That means that the following line does not add the 1 to the whole number times as it should:
wholeTime = wholeTime + WorksheetFunction.RoundDown(remainder, 0)
And that this line will return a 1 which gets divided by 2.5 when it shouldn't (which is where the .4 comes from):
remainder = (remainder - WorksheetFunction.RoundDown(remainder, 0)) / 2.5
I'm not exactly sure what's going on or why excel is rounding my remainder of 1 to 0 if that is indeed the problem. I appreciate any help at all and let me know if you need any more information. Thanks!

Here's a slightly different way of doing things so as not to wind up with the 0.3999999 in place of the 4. Note that I used the VBA Int function which should execute more rapidly than the worksheetfunction.roundown(n,0).
By multiplying time * 10, and then, with the Mod function summing the last digit, we can do integer math until it is time to convert back to the final result.
Also note that the below routine is designed for positive numbers only. If you may be having negative numbers on your time sheet, you should use Fix in place of Int
Option Explicit
Function newMath(week As Range) As Double
Dim time As Range
Dim remainder As Variant
Dim wholeTime As Long
remainder = 0
wholeTime = 0
For Each time In week
wholeTime = wholeTime + Int(time)
remainder = remainder + (time * 10) Mod 10
Next time
'Problem occurs at this point when remainder = 1
'WorksheetFunction.RoundDown(remainder, 0) will equal 0 below even when 1 should round down to 1
wholeTime = wholeTime + Int(remainder / 4) 'Add the whole remainder hours to whole time
remainder = ((remainder / 4) - Int(remainder / 4)) / 2.5 'Get decimal value of remainder and convert back to quadrant
newMath = wholeTime + remainder
End Function

Try this code:
Function newMath(Rng As Range) As Double
Dim CL As Range
Dim hs As Long, hs1 As Long
Dim ms As Double, ms1 As Double, ms2 As Double
For Each CL In Rng
hs = hs + Fix(CL.Value)
ms = ms + CL.Value
Next
ms1 = Round((ms - hs), 1)
hs1 = Fix(ms1 / 0.4)
ms2 = ms1 - (hs1 * 0.4)
newMath = hs + hs1 + ms2
End Function

Related

Convert integer value to fractional value (decimal)

Looking for a way to convert a positive number (integer) from e.g. 123 to 0.123 without using strings. Can be any size integer. Not concerned about negative values.
Dim value As Integer = 123
Dim num As Decimal = "." & value.ToString
It seems simple but I'm not sure how to do it using math. How can I convert without using strings?
You can get the number of digits using Log10. I think the best way is thusly:
Dim value = 123 'Or whatever other value
Dim digitCount = Math.Floor(Math.Log10(Math.Abs(value))) + 1
Dim result = value * CDec(10 ^ (-digitCount))
You need to use Floor rather than Ceiling in order to get the right result for 0, 10, 100, etc.
Here's one method:
Dim value As Integer = 123
Dim num As Decimal = value
While Math.Abs(num) >= 1
num = num / 10
End While
The Math.Abs takes care of negatives, so you could remove it as you say you're not concerned with them.
This also works:
Dim value as Integer = 123
Dim num as Decimal = value
num /= 10 ^ Math.Ceiling(Math.Log10(value))
It's a little harder to see what's going on initially, but it basically finds the next power of 10 that is above the number, and divides by the 10^(that power)
Edit As per Craigs answer Math.Floor then add one works better than Math.Ceiling thus:
Dim value as Integer = 123
Dim num as Decimal = value
num /= 10 ^ (Math.Floor(Math.Log10(value)) + 1)
Edit
I just did a quick performance comparison, and on my PC doing the While loop took 851ms, and the Log10 method took 158ms. That's for 1,000,000 iterations of each.

Format number in datagridview- If integer then F0, if decimal then F

I need to format all numbers in a datagridview.
If the number is a whole number then do not show the decimal point and if the number has a fraction then do show the decimal point.
I have achieved this by looping through each column and checking if the content is a double/single/decimal and then looping through each row in those columns to check each value whether the number is whole or has a fraction.
But this takes a long time for the application to process since i might have 2000 rows or more with 5 or more columns being double/single/decimal.
I can't find a standard format which does this.
Can anybody help?
dgv.SuspendLayout()
For i = 0 To dgv.Columns.Count - 1
If dgv.Columns(i).ValueType = GetType(Double) Or dgv.Columns(i).ValueType = GetType(Single) Or dgv.Columns(i).ValueType = GetType(Decimal) Then
'check If the number has a fraction
For u = 0 To dgv.Rows.Count - 1
If Not IsDBNull(dgv.Rows(u).Cells(i).Value) Then
If dgv.Rows(u).Cells(i).Value Mod 1 <> 0 Then
'number has a fraction
dgv.Rows(u).Cells(i).Style.Format = "F"
Else
'number is an integer
dgv.Rows(u).Cells(i).Style.Format = "F0"
End If
End If
Next
End If
Next
dgv.ResumeLayout()
Using the Datagridview.CellFormatting event seemed to solve the issue - Thanks Jimi. I just can't understand the difference between using the event and setting the format in a loop after populating the datagridview

Excel VBA Overflows when dividing two Doubles

I'm getting an Overflow error when I try to divide two doubles, and I can't figure out why.
Here's my code as it is now
'x will be used to sum the elements
Dim x, ct As Double
x = 0
ct = 0
For Each cell In Range(rng)
If cell.Offset(, offset1).Value = Crit1 And cell.Offset(, offset2).Value = Crit2 Then
x = x + cell.Value
ct = ct + 1
End If
Next
'Divide by count
Avg = x / ct
At first, ct was declared as Long, but I changed it to Double to see if that might fix it, but it didn't.
I've also tried changing the last line to Avg = CDbl(x / ct), but I get the same error.
The values in cell.Value will always be real numbers, usually ranging between 0 and about 9,000,000, occasionally going up as high as 17,000,000. The numbers greater than about 20,000 are almost always integers.
It's divide by zero error. VBA just reported it as "overflow".

Increment the last digit of a number

VB2010 I have a user form where the user inputs a number format. The routine then cycles through a list of number pairs and displays them in a list of categories:
User format "0.00"
0.00 - 164.04
164.04 - 410.10
410.10 - 820.21
What I am trying to do is to increment the first value by one digit so there is no overlap. something like:
0.00 - 164.04
164.05 - 410.10
410.11 - 820.21
I am trying to make it so it works with any number format the user inputs like "0.000" or "0.0". What I currently have is (example for value 164.04)
1. Convert the value to a string "164.04"
2. Take the right most character "4" and convert to an integer 4
3. Increment the integer value by 1 to get 5
4. Take the characters in the string from step #1 except the last and then append
the integer from Step #3 as a string to get "164.05".
Seemed to work in my VB6 program but wanted to see if anyone had any better ideas. I also don't think i accounted for the last digit being a 9.
Update: based on the suggestions below what ended up working for positive and negative numbers and integers and floats was the following:
Dim p As Integer
Dim numAsStr As String = num.ToString(fmt)
If numAsStr.IndexOf(".") = -1 Then
p = 0
Else
p = numAsStr.Length - numAsStr.IndexOf(".") - 1
End If
Dim result as Double = ((num* (10 ^ p) + 1.0) / (10 ^ p))
Here is the algorithm:
1.Find decimal points (p)
2.multiply the number by 10^p, increase it by one, divide it back by 10^p
Dim numAsStr As String = num.ToString()
Dim p As Integer = numAsStr.Length - numAsStr.IndexOf(".") - 1
Dim numInt as Integer = 10^p * num
Dim result as Double = ((10^p *num + 1.0) / 10^p).ToString()
Use "ON ERROR RESUME NEXT" construct for this problem.

How can I test if a user input is a decimal with no more than 2 digits after the decimal place?

I'm supposed to make a banking software form that allows a user to create accounts and make deposits and withdrawals for any account. But I cannot figure out how to make it accept an integer, a decimal with only one digit after the dot, or a decimal with the first digit after the dot being a 0.
Dim x As Decimal = Decimal.Parse(txtAmount.Text)
If (txtAmount.Text.IndexOf(".") <> -1 And txtAmount.Text.Substring(txtAmount.Text.IndexOf("." + 1)).Length > 2) Then
MessageBox.Show("No fractions of a penny")
Exit Sub
End If
Dim a As CAccount = lbxCustomers.SelectedItem
a.deposit(x)
Anyone know what I'm doing wrong?
Using the tryparse as suggested is most definitely a good starting point. One simple way to disregard extra digits is with the Truncate method:
Dim x As Decimal
If Decimal.TryParse(txtAmount.Text, x) Then
x = Decimal.Round(x * 100) / 100
Else
MessageBox.Show("Only valid numbers please")
End If
This will leave x with only a maximum of 2 decimal places. This also rounds the resulting value according to the value in the extra digits. This is useful for the Decimal type since it is prone to rounding errors and this will even them out.
You can compare the current value with the rounded value. If the two are equal, you know there isn't more digits. This won't work if you want to also limit zeros (2.0000 will pass).
Dim val As Decimal
val = 2.2345
If val * 100 = Math.Floor(val * 100) Then
' Has 2 or less digit
Else
' Has more than 2 digit
End If