How to Truncate a Double in VBA - vba

I have a variable in VBA that I need to truncate to 4 significant figures. I can't seem to find anything that won't round the number up or down. But I just want to remove the numbers after the 4th significant figure. I've tried,
compressibility = round(compress, -3 - (Int(Log(Abs(compress)))))
It removes the numbers after the 4th digit but it still rounds the number up.
Compress is a number around 0.000245848385 as an example, and I need the compressibility number to be 0.0002458.
Any suggestions would be great! Thanks.

Try this function:
Function RoundSignificant(ByVal dValue As Double, iFigures As Integer)
Dim dSig As Double
dSig = Abs(dValue)
dSig = Application.Log10(dSig)
dSig = 1 + Int(dSig)
dSig = iFigures - dSig
RoundSignificant = Round(dValue, dSig)
End Function
Sub test()
Debug.Print RoundSignificant(0.000245848385, 4)
End Sub

Using worksheet functions:
=VALUE(TEXT(compress,"0.000E+00"))
For VBA
CDbl(Format(compress,"0.000E+00"))
Hope that helps.

It seems to me that you want to avoid rounding UP, but not rounding down, since rounding down should produce the exact result you want. So, instead of using VBA Round function, you could use Excel WorksheetFunction.RoundDown method to achieve the result you need.
ROUNDDOWN(0.00024586548385;7)=0.000245800000
ROUNDDOWN(0.00024583548385;7)=0.000245800000

Sub test()
Dim compress As Double
compress = 0.000245858
Dim compressibility As Double
compressibility = Int(compress * 10 ^ -(Int(Log(Abs(compress))) - 3)) / 10 ^ -(Int(Log(Abs(compress))) - 3)
Debug.Print compressibility
End Sub

Related

Variant and if statement - VBA [duplicate]

I have trouble comparing 2 double in Excel VBA
suppose that I have the following code
Dim a as double
Dim b as double
a = 0.15
b = 0.01
After a few manipulations on b, b is now equal to 0.6
however the imprecision related to the double data type gives me headache because
if a = b then
//this will never trigger
end if
Do you know how I can remove the trailing imprecision on the double type?
You can't compare floating point values for equality. See this article on "Comparing floating point numbers" for a discussion of how to handle the intrinsic error.
It isn't as simple as comparing to a constant error margin unless you know for sure what the absolute range of the floats is beforehand.
if you are going to do this....
Dim a as double
Dim b as double
a = 0.15
b = 0.01
you need to add the round function in your IF statement like this...
If Round(a,2) = Round(b,2) Then
//code inside block will now trigger.
End If
See also here for additional Microsoft reference.
It is never wise to compare doubles on equality.
Some decimal values map to several floating point representations. So one 0.6 is not always equal to the other 0.6.
If we subtract one from the other, we probably get something like 0.00000000051.
We can now define equality as having a difference smaller that a certain error margin.
Here is a simple function I wrote:
Function dblCheckTheSame(number1 As Double, number2 As Double, Optional Digits As Integer = 12) As Boolean
If (number1 - number2) ^ 2 < (10 ^ -Digits) ^ 2 Then
dblCheckTheSame = True
Else
dblCheckTheSame = False
End If
End Function
Call it with:
MsgBox dblCheckTheSame(1.2345, 1.23456789)
MsgBox dblCheckTheSame(1.2345, 1.23456789, 4)
MsgBox dblCheckTheSame(1.2345678900001, 1.2345678900002)
MsgBox dblCheckTheSame(1.2345678900001, 1.2345678900002, 14)
As has been pointed out, many decimal numbers cannot be represented precisely as traditional floating-point types. Depending on the nature of your problem space, you may be better off using the Decimal VBA type which can represent decimal numbers (base 10) with perfect precision up to a certain decimal point. This is often done for representing money for example where 2-digit decimal precision is often desired.
Dim a as Decimal
Dim b as Decimal
a = 0.15
b = 0.01
Late answer but I'm surprised a solution hasn't been posted that addresses the concerns outlined in the article linked in the (currently) accepted answer, namely that:
Rounding checks equality with absolute tolerance (e.g. 0.0001 units if rounded to 4d.p.) which is rubbish when comparing different values on multiple orders of magnitude (so not just comparing to 0)
Relative tolerance that scales with one of the numbers being compared meanwhile is not mentioned in the current answers, but performs well on non-zero comparisons (however will be bad at comparing to zero as the scaling blows up around then).
To solve this, I've taken inspiration from Python: PEP 485 -- A Function for testing approximate equality to implement the following (in a standard module):
Code
'#NoIndent: Don't want to lose our description annotations
'#Folder("Tests.Utils")
Option Explicit
Option Private Module
'Based on Python's math.isclose https://github.com/python/cpython/blob/17f94e28882e1e2b331ace93f42e8615383dee59/Modules/mathmodule.c#L2962-L3003
'math.isclose -> boolean
' a: double
' b: double
' relTol: double = 1e-09
' maximum difference for being considered "close", relative to the
' magnitude of the input values
' absTol: double = 0.0
' maximum difference for being considered "close", regardless of the
' magnitude of the input values
'Determine whether two floating point numbers are close in value.
'Return True if a is close in value to b, and False otherwise.
'For the values to be considered close, the difference between them
'must be smaller than at least one of the tolerances.
'-inf, inf and NaN behave similarly to the IEEE 754 Standard. That
'is, NaN is not close to anything, even itself. inf and -inf are
'only close to themselves.
'#Description("Determine whether two floating point numbers are close in value, accounting for special values in IEEE 754")
Public Function IsClose(ByVal a As Double, ByVal b As Double, _
Optional ByVal relTol As Double = 0.000000001, _
Optional ByVal absTol As Double = 0 _
) As Boolean
If relTol < 0# Or absTol < 0# Then
Err.Raise 5, Description:="tolerances must be non-negative"
ElseIf a = b Then
'Short circuit exact equality -- needed to catch two infinities of
' the same sign. And perhaps speeds things up a bit sometimes.
IsClose = True
ElseIf IsInfinity(a) Or IsInfinity(b) Then
'This catches the case of two infinities of opposite sign, or
' one infinity and one finite number. Two infinities of opposite
' sign would otherwise have an infinite relative tolerance.
'Two infinities of the same sign are caught by the equality check
' above.
IsClose = False
Else
'Now do the regular computation on finite arguments. Here an
' infinite tolerance will always result in the function returning True,
' since an infinite difference will be <= to the infinite tolerance.
'This is to supress overflow errors as we deal with infinity.
'NaN has already been filtered out in the equality checks earlier.
On Error Resume Next
Dim diff As Double: diff = Abs(b - a)
If diff <= absTol Then
IsClose = True
ElseIf diff <= CDbl(Abs(relTol * b)) Then
IsClose = True
ElseIf diff <= CDbl(Abs(relTol * a)) Then
IsClose = True
End If
On Error GoTo 0
End If
End Function
'#Description "Checks if Number is IEEE754 +/- inf, won't raise an error"
Public IsInfinity(ByVal Number As Double) As Boolean
On Error Resume Next 'in case of NaN
IsInfinity = Abs(Number) = PosInf
On Error GoTo 0
End Function
'#Description "IEEE754 -inf"
Public Property Get NegInf() As Double
On Error Resume Next
NegInf = -1 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 +inf"
Public Property Get PosInf() As Double
On Error Resume Next
PosInf = 1 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 signaling NaN (sNaN)"
Public Property Get NaN() As Double
On Error Resume Next
NaN = 0 / 0
On Error GoTo 0
End Property
'#Description "IEEE754 quiet NaN (qNaN)"
Public Property Get QNaN() As Double
QNaN = -NaN
End Property
Updated to incorporate great feedback from Cristian Buse
Examples
The IsClose function can be used to check for absolute difference:
assert(IsClose(0, 0.0001233, absTol:= 0.001)) 'same to 3 d.p.?
... or relative difference:
assert(IsClose(1234.5, 1234.6, relTol:= 0.0001)) '0.01% relative difference?
... but generally you specify both and if either tolerance is met then the numbers are considered close. It has special handling of +-infinity which are only close to themselves, and NaN which is close to nothing (see the PEP for full justification, or my Code Review post where I'd love feedback on this code :)
The Currency data type may be a good alternative. It handles relatively large numbers with fixed four digit precision.
Work-a-round??
Not sure if this will answer all scenarios, but I ran into a problem comparing rounded double values in VBA. When I compared to numbers that appeared to be identical after rounding, VBA would trigger false in an if-then compare statement.
My fix was to run two conversions, first double to string, then string to double, and then do the compare.
Simulated Example
I did not record the exact numbers that caused the error mentioned in this post, and the amounts in my example do not trigger the problem currently and are intended to represent the type of issue.
Sub Test_Rounded_Numbers()
Dim Num1 As Double
Dim Num2 As Double
Let Num1 = 123.123456789
Let Num2 = 123.123467891
Let Num1 = Round(Num1, 4) '123.1235
Let Num2 = Round(Num2, 4) '123.1235
If Num1 = Num2 Then
MsgBox "Correct Match, " & Num1 & " does equal " & Num2
Else
MsgBox "Inccorrect Match, " & Num1 & " does not equal " & Num2
End If
'Here it would say that "Inccorrect Match, 123.1235 does not equal 123.1235."
End Sub
Sub Fixed_Double_Value_Type_Compare_Issue()
Dim Num1 As Double
Dim Num2 As Double
Let Num1 = 123.123456789
Let Num2 = 123.123467891
Let Num1 = Round(Num1, 4) '123.1235
Let Num2 = Round(Num2, 4) '123.1235
'Add CDbl(CStr(Double_Value))
'By doing this step the numbers
'would trigger if they matched
'100% of the time
If CDbl(CStr(Num1)) = CDbl(CStr(Num2)) Then
MsgBox "Correct Match"
Else
MsgBox "Inccorrect Match"
End If
'Now it says Here it would say that "Correct Match, 123.1235 does equal 123.1235."
End Sub
Depending on your situation and your data, and if you're happy with the level of precision shown by default, you can try comparing the string conversions of the numbers as a very simple coding solution:
if cstr(a) = cstr(b)
This will include as much precision as would be displayed by default, which is generally sufficient to consider the numbers equal.
This would be inefficient for very large data sets, but for me was useful when reconciling imported data which was identical but was not matching after storing the data in VBA Arrays.
Try to use Single values if possible.
Conversion to Double values generates random errors.
Public Sub Test()
Dim D01 As Double
Dim D02 As Double
Dim S01 As Single
Dim S02 As Single
S01 = 45.678 / 12
S02 = 45.678
D01 = S01
D02 = S02
Debug.Print S01 * 12
Debug.Print S02
Debug.Print D01 * 12
Debug.Print D02
End Sub
45,678
45,678
45,67799949646
45,6780014038086

VBA: Calculation gone wrong #VALUE

I've been tasked with creating a Value at Risk function that can reference data in a range and a couple of cells. Code is:
Option Explicit
Function VaR(returns As Range, days, confidenceinterval, portfoliovalue)
VaR = (Application.WorksheetFunction.Average(returns) * Application.WorksheetFunction.SQRT(days)) - (Application.WorksheetFunction.NormSDist(confidenceinterval) * (Application.WorksheetFunction.StDev_S(returns) * Application.WorksheetFunction.SQRT(days))) * portfoliovalue
End Function
Returns is a range of returns, while the others are just values in cells.
As you can infer, i just copied my excel test formula, adding application.worksheet before each of the arguments. However, whereas my test formula works, the identical code translated in a format the VBA should recognised, does not.
The original formula is
=(AVERAGE(returns)*SQRT(days))-(NORMSDIST(confidenceinterval)*(STDEV.S(returns)*SQRT(days)))*portfoliovalue
Any help would be really excellent!
Thank you in advance!
You have two problems. First, your function name VaR conflicts with Excel's built-in VAR (variance) function. Second, there is no Application.WorksheetFunction.SQRT function; use VBA's Sqr instead. This should work:
Function ValueAtRisk(returns As Range, days, confidenceinterval, portfoliovalue)
With Application.WorksheetFunction
ValueAtRisk = (.Average(returns) * Sqr(days)) - (.NormSDist(confidenceinterval) * (.StDev_S(returns) * Sqr(days))) * portfoliovalue
End With
End Function
Hope that helps
If you want a VBA function to return a value the format to do so is
'Function functionName(parameters As parameterType) As returnType
So yours (assuming the types I've chosen are correct) should resolve to:
Function VaR(returns As Range, days As Integer, confidenceinterval as Double, portfoliovalue As Double) As Double
Based on Scott's suggestion here is one way that you might choose to break up and "step through" the formula that you're working on. If in your code window you show View > Locals Window you can use F8 to step through your code line by line you can see the values of part1 and part2 as they update from operation to operation.
Option Explicit
Function VaR(returns As Range, days As Integer, confidenceinterval As Double, portfoliovalue As Double) As Double
Dim part1 As Double
Dim part2 As Double
With Application.WorksheetFunction
part1 = .Average(returns) * .SQRT(days)
part2 = .NormSDist(confidenceinterval) * (.StDev_S(returns) * .SQRT(days))
VaR = part1 - part2 * portfoliovalue
End With
End Function
Since the test formula that you have to work with is
=(AVERAGE(returns)*SQRT(days))-(NORMSDIST(confidenceinterval)*(STDEV.S(returns)*SQRT(days)))*portfoliovalue
I would recommend splitting each part up so that you can compare, for example, my part1 to =(AVERAGE(returns)*SQRT(days)) and so on

Suggestions for a user-defined function for significant figures and trailing zeros in Excel/VBA

I have written the user-defined function (UDF) below for an Excel sheet at work. It rounds to significant figure and is able to handle trailing zeros.
Actually, the UDF works as intended! The only thing, that you need to be aware off is that it convert the number to text.
However, I'm just a bit suspicious that I've overlooked something. Compared to the others functions, that I have found (Eg. https://www.vertex42.com/ExcelTips/significant-figures.html), it seems almost too simple.
Public Function ROUNDSF(num As Double, sigFig As Integer)
Dim sigPlace As Integer
Dim numFormat As String
sigPlace = sigFig - (1 + Int(Log(num) / Log(10)))
numFormat = "0." & String(sigPlace, "0")
ROUNDSF= Format(num, numFormat)
End Function
Are there anything, that I overlooked in this UDF? Or any suggestions?
If you want it to return a value, you could close the UDF with:
ROUNDSF = Val(Format(num, numFormat))
Keep in mind though, this will then use existing default formatting so make sure there is either none, or that it's compatible with your requirement.
As per Vincent's comment, if your user's locale settings might use something other than . as a decimal separator, use Cdbl:
ROUNDSF = CDbl(Format(num, numFormat))
You should also trap for -ve SigPlace values that could arise, like so:
Public Function ROUNDSF(num As Double, sigFig As Integer) As Double
Dim sigPlace As Integer
Dim numFormat As String
sigPlace = sigFig - (1 + Int(Log(num) / Log(10)))
If sigPlace < 0 Then sigPlace = 0
numFormat = "0." & String(sigPlace, "0")
ROUNDSF = Cdbl(Format(num, numFormat))
End Function

VB - Divide integers doesn't include commas?

This is probably an easy one, but I've got this Excel vba macro where I'm trying to divide two integers and I end up with a round number, even though there should be a comma in there.
For example 278 / 101 = 3. While it's really 2,75 and not 3. Why is this?
The macro is really simple, like this:
Dim intFull, intLow , intDivided as Integer
intFull = 278
intLow = 101
intDivided = intFull \ intLow
Your result variables is an integer
If you work with doubles instead you will get 2.752 etc - which can be rounded using dbDivided = Round(lngFull / lngLow, 2)
[variables updated to be more meaningful]
Sub redone()
Dim lngFull As Long
Dim lngLow As Long
Dim dbDivided As Double
lngFull = 278
lngLow = 101
dbDivided = Round(lngFull / lngLow, 2)
End Sub
Sure you used a forward slash and not a backslash? (See also: http://zo-d.com/blog/archives/programming/vba-integer-division-and-mod.html)

How do I cope with rounding errors on doubles in vb.net?

I'm trying to balance a set of currency values using vb.net. The totals for both these values is cast as a double. I'm getting rounding errors in some situations.
What's the best way to avoid this? Is there a type I can use in preference to double? How do I round the resultant value to two decimal places?
Here's my code - I probably don't need to show it, but just in case.
Dim nInvValue As Double
Dim nCreditValue As Double
For Each oReferenceItem In oMatchInvoices
Dim nUnallocated As Double = oReferenceItem.DocumentOutstandingValue - oReferenceItem.DocumentAllocatedValue
If ((nUnallocated <> 0) And (sReferenceValue = oReferenceItem.InstrumentNo)) Then
iCount = iCount + 1
If (oReferenceItem.IsDebit) And (nUnallocated > 0) Then
nInvValue = nInvValue + nUnallocated
InvoiceList.Add(nUnallocated.ToString("c"), oReferenceItem.URN.ToString)
End If
If (oReferenceItem.IsCredit) And (nUnallocated < 0) Then
nCreditValue = nCreditValue - nUnallocated
CreditList.Add(nUnallocated.ToString("c"), oReferenceItem.URN.ToString)
End If
End If
Next
For financial calculations I believe that the current wisdom is to use Decimals instead of Doubles.
You might be interested in this discussion Decimal Vs. Double.
Try using the Decimal type.
MSDN - Decimal