Excel

Calculate High-Precision Square Root using Decimal Data Type

Ease of Use

Easy

Version tested with

2002 

Submitted by:

nitt1995

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:

instructions for use

			

' 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 error As Variant 'Error of answer*answer compared to original value 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, 'Use Excel Calculation instead 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:

SquareRootCalculator.ZIP 14.56KB 

Approved by mdmackillop


This entry has been viewed 123 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express