VBA Get Function

[Boingts]

Hi all

I have a scenario where I need to truncate a number to 4 decimal places ( no rounding) .

I have searched google and this site and found the Get() Function. This function works great IF the decimals to 4 places are greater 0 ( 515.1234678 gives me 515.1234) however if the number is to only 1, 2 or 3 decimal places places it does not work ( 515.40000000 gives me 515.3999 - my expectation would be 515.40000000 = 515.4000)

Here are the two Functions i have used to try get this resolved

Function FixFuntion(number As Double) As Double
FixFuntion = Fix(number * 10000) / 10000
End Function


Function FixDecimal(ByVal number As Double, ByVal digits As Integer) As Double
    Dim x As Integer
    x = 10 ^ digits
    FixDecimal = Fix(number * x) / x
End Function

Am I using these correctly or is there another fix that could be used ?

Thank you in advance

 

[RoryA]

Welcome to the forum.

I can't replicate that. How are you using the function - is the value you are passing in the result of a formula, or a typed-in value?

 

[steve the fish]

Doesnt the built in TRUNC function do just what you want or am i missing something?

 

[Boingts]

Welcome to the forum.

I can't replicate that. How are you using the function - is the value you are passing in the result of a formula, or a typed-in value?

Hi Rory - thank you the reply

I have the FixFuntion (contains the Get) wrapped around a formula, however if i just use the number typed into a cell i get the same result.

The primary one of the examples i am using is

Function FixFuntion(number As Double) As Double
FixFuntion = Fix(number * 10000) / 10000
End Function

Here are series of examples i used the function with

500.40000000 = 500.3999 - unexpected - expected 500.4000
500.41000000 = 500.4100 - expected
500.41200000 = 500.4119 - expected
500.41230000 = 500.4123 - expected
500.41234000 = 500.4123 - expected
500.41234500 = 500.4123 - expected
500.41234560 = 500.4123 - expected
500.4123457 = 500.4123 - expected

The Hack of the fix function was something i found on Google and may be the issue

If I try anything else it seems to round the figure which is not what i require

Cheers

 

[Boingts]

Hi Steve - I am using the in VBA and not Excel ( Trunc works great in Excel) - I have tried to use the With Application in VBA but Trunc is not on the list

 

[steve the fish]

I can replicate what you are saying and the maths you use seems sound. It's the computation within vba that seems to go wrong. I can get the 515.4 to work but then others produce incorrect results. I'll see if I can see a pattern. Clearly if 515.4 is passed to the function it shouldn't produce 515.3999 based on what is being asked of it.

 

[Boingts]

I can replicate what you are saying and the maths you use seems sound. It's the computation within vba that seems to go wrong. I can get the 515.4 to work but then others produce incorrect results. I'll see if I can see a pattern. Clearly if 515.4 is passed to the function it shouldn't produce 515.3999 based on what is being asked of it.

Hi Steve, thanks for looking at this, and i am glad you agree as i thought i was going crazy. Do you know of any other way of replicating the Excel Trunc built in function in VBA ?

Cheers

 

[steve the fish]

See if you can find one that doesnt work when the calc is split up.

Function FixFunction(number As Double) As Double

number = number * 10000
number = Fix(number)
number = number / 10000
FixFunction = number

'FixFunction = Fix(number * 10000) / 10000

End Function

Sub test()

Dim x As Double

x = 515.4

MsgBox FixFunction(x)

End Sub

 

[Boingts]

See if you can find one that doesnt work when the calc is split up.

Function FixFunction(number As Double) As Double

number = number * 10000
number = Fix(number)
number = number / 10000
FixFunction = number

'FixFunction = Fix(number * 10000) / 10000

End Function

Sub test()

Dim x As Double

x = 515.4

MsgBox FixFunction(x)

End Sub

Hi Steve - I ran that but all answers = 0, Also the Msg Box displayed 0 too

Cheers

 

[Boingts]

Hi Steve - I ran that but all answers = 0, Also the Msg Box displayed 0 too

Cheers

Apologies - I changed the function name but did not update the code correctly - yes that works - thank you !!!