Excel

Calculate High-Precision Square Root using Decimal Data Type

Ease of Use

Easy

Version tested with

2002

Submitted by:

Description:

VBA (and Excel for that matter) only provide methods for calculating the square root of a number using double precision (14 decimal places). This code provides a method to generate the square root to VBA's Decimal Precision (28 decimal places). This code was tested with Excel 2002 but should work on Excel 2000 and later

Discussion:

In applications such as statistics where you need to carry through calculations to 28 decimal places, you need to use calculations that can support beyond the Double precision 14 decimal places. Standard VBA operations such as +,-,* and / support the Decimal Presision, but Square Root and Exp are examples of calculations that only support Double precision. This code provides a solution of the Square Root problem by using Newton's Method. I found a discussion of this method along with Java implementation on http://www.merriampark.com/bigsqrt.htm, and taylored the code for VBA to suit my needs.

Code:

```			 ' Modified from Java code found at http://www.merriampark.com/bigsqrt.htm
' by Michael Gilleland, Merriam Park Software
' The Sqr() function in VBA returns double, which results in precision loss
' if you are using the Decimal data type.
'
' This uses Newton's method to calculate the SQRT when higher precision is
' required.  The error of this method is compared to that of the
' standard calculation.  If the error is greater, than the standard
' calculation is used instead.  This should only occur if the number of
' iterations is not high enough.

' The decimal data type was introduced in Excel 2000 and cannot be declared
' Explicitly.  You must declare as variant and use CDEC() command to ensure
' that decimal data type is used.  This type gives a range of
' +/- 79,228,162,514,264,337,593,543,950,335 for integers and
' +/- 7.9228162514264337593543950335 for 28 decimal places.

Option Explicit
Option Private Module

'These are global variables potentially useful for the main subroutine
Private iterations As Integer 'Number of iterations required to converge
Private title As String 'Used for main routine msgBox

'  //--------------------------
'  // Get initial approximation
'  //--------------------------
'Setting an initial value is not required, but helps to converge faster.
'The alternative is to always set the initial value to 1
Function getInitialApproximation(n As Variant) As Variant 'Decimal type
Dim integerPart As Variant 'Decimal type
Dim length As Integer
Dim guess As Variant 'Decimal type
Dim ONE As Variant

ONE = CDec("1.00000000000000000000000000000000")
integerPart = Round(n, 0)
length = Len(integerPart)
If (length Mod 2 = 0) Then
length = length - 1
End If
length = length / 2
guess = CDec(ONE * 10 ^ length)
getInitialApproximation = guess
End Function
'  //----------------
'  // Get square root
'  //----------------
Function getBigSquareRoot(n As Variant) As Variant 'Decimal type
'    // Make sure n is a positive number
Dim initialGuess As Variant
Dim guess, lastGuess As Variant
Dim more As Boolean
Dim ZERO, ONE, TWO As Variant

ZERO = CDec("0.0000000000000000000000000000")
ONE = CDec(" 0.0000000000000000000000000001")
TWO = CDec(" 2.0000000000000000000000000000")

If (n <= ZERO) Then Exit Function

initialGuess = getInitialApproximation(n)
lastGuess = ZERO
guess = initialGuess
'// Iterate
iterations = 0
more = True

While (more)
lastGuess = guess
guess = CDec(n / guess)
guess = CDec(guess + lastGuess)
guess = CDec(guess / TWO)

iterations = iterations + 1
If Abs(lastGuess - guess) <= ONE Then
more = False
End If
Wend
'In the unexpected case that the error exceeds
'Excels standard double-precision calculator,
error = CDec(n - guess * guess)
If Abs(error) > Abs(getDoubleSquareRootError(n)) Then
guess = Sqr(n)
End If
getBigSquareRoot = CDec(guess)
End Function
' This calculates the error of the standard Excel Square Root Function.
' If this error is less than the high-precision function, there was a
' convergance issue and use the standard function instead.
Function getDoubleSquareRootError(n As Variant) As Double
Dim sqrt As Double
Dim error As Double
sqrt = Sqr(n)
error = (n - sqrt * sqrt)
getDoubleSquareRootError = error
End Function
'  This is a sample case for testing.  change the value of testNums to test
' Various scenerios
'  //-----
'  // Test
'  //-----
Sub main()
Dim n, sqrt, nIterations As Variant
Dim testNums() As Variant
Dim response As Integer

title = "High-Precision Square Root Calculator"
10:
'Request value for calculation
n = InputBox(Prompt:="Input Value for Square Root Calculation", _
title:=title)
'If cancel then exit sub
If n = "" Then
Exit Sub
Else
On Error GoTo CatchTypeError
n = CDec(n)
End If
'Number must be greater than 0
If n <= 0 Then
InvalidNumberError
GoTo 10
Exit Sub
End If

On Error GoTo CatchSqrRootError
sqrt = getBigSquareRoot(n)

response = MsgBox(Prompt:="Paste Results in Active Cell?", _
title:=title, _
Buttons:=vbYesNo + vbInformation)
If response = VbMsgBoxResult.vbYes Then
Application.ActiveCell.Value = sqrt
End If
MsgBox Prompt:="Computing the square root of: " & n & vbCrLf _
& "Iterations: " & iterations & vbCrLf _
& "Sqrt: " & sqrt & vbCrLf _
& "Sqrt Squared: " & sqrt * sqrt & vbCrLf _
& "Error: " & error, _
title:=title, _
Buttons:=vbApplicationModal
Exit Sub
CatchTypeError:
InvalidNumberError
Err = False
Resume 10
Exit Sub
CatchSqrRootError:
MsgBox Prompt:="Calculation Error" & vbCrLf _
& "Value Probably Exceeds Limits", _
title:=title, _
Buttons:=vbExclamation
Err = False
Resume 10
Exit Sub
End Sub
Sub InvalidNumberError()
Dim msg As String
msg = "Invalid Number" & vbCrLf _
& "Please enter number >= 0 and" & vbCrLf _
& "<=79,228,162,514,264,337,593,543,950,335"
MsgBox Prompt:=msg, _
title:=title, _
Buttons:=vbExclamation
End Sub
Sub Button1_Click()
main
End Sub

```

How to use:

1. This code should execute as a stand alone module by calling the main subroutine. If you wish to use the square root function in your own calculations, place this code in a module and call getBigSquareRoot(NUMBER) where NUMBER is the value that you wish to operate on. If you wish to increase/decrease the allowable number of iterations, place the command setMaxIterations(ITERATIONS ) directly before the getBigSquareRoot function to set the maximum number of iterations (where ITERATIONS is the value you set). Ensure that all values that you want the additional precision are dimensioned as Variants (DIM xxxxxx as Variant).
2. If used from whithin an excel worksheet cell, only double precision is shown.

Test the code:

1. Open worksheet and push Suare Root Calculator button
2. -or-
3. Open VBA module and edit main subroutine

Sample File:

Approved by mdmackillop

This entry has been viewed 123 times.

Copyright @2004 - 2020 VBA Express