Visual Basic for Applications/Big Number Arithmetic with Strings

Summary

• This VBA module is intended for Microsoft Excel but can run with minor changes in any of the MS Office applications with a VBA editor.
• The data types of VBA prevent big number calculations. That is to say, beyond twenty or thirty digits, and even then much care is needed to avoid overflow. Strings have few such restrictions, being limited in most cases to the size of the memory space of the application.
• The code module below includes most of the basic arithmetic functions without any size restriction.
• The work is not by this author, but credit should be given to Rebecca Gabriella's String Math Module notes at Big Integer Library. This author has made only cosmetic changes to the work, and added a test procedure to illustrate its use.

Code Notes

• The module includes functions for the following: Addition, subtraction, multiplication, and division, all using integer strings. Also included are conversion functions to restore base10 from some other base, and to produce a new base from some existing base10 input. Other support functions such as RealMod() are also included.
• No output code to the sheet has been provided. Owing to Excel's habit of truncating numbers, even if they are strings, users who want to use the worksheet should concatenate an apostrophe before the display string to prevent this happening. The apostrophe will not be displayed. It is unclear how else this device affects the subsequent use of the numbers.
• A remainder after division is produced. It can be found as sLastRemainder, and is public.
• Users who install code in MS Access should change the Option Compare Text to Option Compare DataBase. The former is intended for MS Excel.

The VBA String Math Module

Option Explicit
Option Compare Text 'Database for Access
'--------------------------------------------------------------------------------------------------------------
'https://cosxoverx.livejournal.com/47220.html
'Credit to Rebecca Gabriella's String Math Module (Big Integer Library) for VBA (Visual Basic for Applications)
' Minor edits made with comments and other.
'--------------------------------------------------------------------------------------------------------------

Public Type PartialDivideInfo
    Quotient As Integer
    Subtrahend As String
    Remainder As String
End Type

Public sLastRemainder As String
Private Const Alphabet = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Private Sub TestMultAndDiv()
    'Run this to test multiplication and division with integer strings
    'Open immediate window in View or with ctrl-g to see results
    
    Dim sP1 As String, sP2 As String, sRes1 As String, sRes2 As String
    
    sP1 = "6864797660130609714981900799081393217269" & _
          "4353001433054093944634591855431833976560" & _
          "5212255964066145455497729631139148085803" & _
          "7121987999716643812574028291115057151"         '157 digits and prime
    sP2 = "162259276829213363391578010288127"             '33 digits and also prime

    'multiply these two as integer strings
    sRes1 = Multiply(sP1, sP2)
    Debug.Print sP1
    Debug.Print "Length of 1st number : " & Len(sP1)
    Debug.Print sP2
    Debug.Print "Length of 2nd number : " & Len(sP2)
    Debug.Print "Product : " & sRes1
    Debug.Print "Length of product : " & Len(sRes1)
    Debug.Print " "

    'then divide the product by sP1 obtains sP2 again
    sRes2 = Divide(sRes1, sP1)
    Debug.Print sRes1
    Debug.Print "Length of 1st number : " & Len(sRes1)
    Debug.Print sP1
    Debug.Print "Length of 2nd number : " & Len(sP1)
    Debug.Print "Integer Quotient : " & sRes2
    Debug.Print "Length of quotient : " & Len(sRes2)
    Debug.Print "Remainder after integer division : " & sLastRemainder
    Debug.Print " "

    'Notes:
    'Clear immediate window with ctrl-g, then ctrl-a, then delete
    'If sending long integer strings to the worksheet, prefix with apostrophe before output
    'or it will be truncated by Excel.  Needs consideration also on pickup from sheet.
    'Alternatively use a textbox in a userform for error free display.  Ctrl-C to copy out.

End Sub

Private Function Compare(ByVal sA As String, ByVal sB As String) As Integer
    'Parameters are string integers of any length, for example "-345...", "973..."
    'Returns an integer that represents one of three states
    'sA > sB returns 1, sA < sB returns -1, and sA = sB returns 0
    'Credit to Rebecca Gabriella's String Math Module with added edits
    'https://cosxoverx.livejournal.com/47220.html
    
    Dim bAN As Boolean, bBN As Boolean, bRN As Boolean
    Dim i As Integer, iA As Integer, iB As Integer
    
    'handle any early exits on basis of signs
    bAN = (Left(sA, 1) = "-")
    bBN = (Left(sB, 1) = "-")
    If bAN Then sA = Mid(sA, 2)
    If bBN Then sB = Mid(sB, 2)
    If bAN And bBN Then
        bRN = True
    ElseIf bBN Then
        Compare = 1
        Exit Function
    ElseIf bAN Then
        Compare = -1
        Exit Function
    Else
        bRN = False
    End If
    
    'remove any leading zeros
    Do While Len(sA) > 1 And Left(sA, 1) = "0"
        sA = Mid(sA, 2) 'starting at pos 2
    Loop
    Do While Len(sB) > 1 And Left(sB, 1) = "0"
        sB = Mid(sB, 2) 'starting at pos 2
    Loop
    
    'then decide size first on basis of length
    If Len(sA) < Len(sB) Then
        Compare = -1
    ElseIf Len(sA) > Len(sB) Then
        Compare = 1
    Else 'unless they are the same length
        Compare = 0
        'then check each digit by digit
        For i = 1 To Len(sA)
            iA = CInt(Mid(sA, i, 1))
            iB = CInt(Mid(sB, i, 1))
            If iA < iB Then
                Compare = -1
                Exit For
            ElseIf iA > iB Then
                Compare = 1
                Exit For
            Else 'defaults zero
            End If
        Next i
    End If
    
    'decide about any negative signs
    If bRN Then
        Compare = -Compare
    End If

End Function

Public Function Add(ByVal sA As String, ByVal sB As String) As String
    'Parameters are string integers of any length, for example "-345...", "973..."
    'Returns sum of sA and sB as string integer in Add()
    'Credit to Rebecca Gabriella's String Math Module with added edits
    'https://cosxoverx.livejournal.com/47220.html
    
    Dim bAN As Boolean, bBN As Boolean, bRN As Boolean
    Dim iA As Integer, iB As Integer, iCarry As Integer
       
    'test for empty parameters
    If Len(sA) = 0 Or Len(sB) = 0 Then
        MsgBox "Empty parameter in Add()"
        Exit Function
    End If
        
    'handle some negative values with Subtract()
    bAN = (Left(sA, 1) = "-")
    bBN = (Left(sB, 1) = "-")
    If bAN Then sA = Mid(sA, 2)
    If bBN Then sB = Mid(sB, 2)
    If bAN And bBN Then 'both negative
        bRN = True      'set output reminder
    ElseIf bBN Then     'use subtraction
        Add = Subtract(sA, sB)
        Exit Function
    ElseIf bAN Then     'use subtraction
        Add = Subtract(sB, sA)
        Exit Function
    Else
        bRN = False
    End If
    
    'add column by column
    iA = Len(sA)
    iB = Len(sB)
    iCarry = 0
    Add = ""
    Do While iA > 0 And iB > 0
        iCarry = iCarry + CInt(Mid(sA, iA, 1)) + CInt(Mid(sB, iB, 1))
        Add = CStr(iCarry Mod 10) + Add
        iCarry = iCarry \ 10
        iA = iA - 1
        iB = iB - 1
    Loop
    
    'Assuming param sA is longer
    Do While iA > 0
        iCarry = iCarry + CInt(Mid(sA, iA, 1))
        Add = CStr(iCarry Mod 10) + Add
        iCarry = iCarry \ 10
        iA = iA - 1
    Loop
    'Assuming param sB is longer
    Do While iB > 0
        iCarry = iCarry + CInt(Mid(sB, iB, 1))
        Add = CStr(iCarry Mod 10) + Add
        iCarry = iCarry \ 10
        iB = iB - 1
    Loop
    Add = CStr(iCarry) + Add
    
    'remove any leading zeros
    Do While Len(Add) > 1 And Left(Add, 1) = "0"
        Add = Mid(Add, 2)
    Loop
    
    'decide about any negative signs
    If Add <> "0" And bRN Then
        Add = "-" + Add
    End If

End Function

Private Function RealMod(ByVal iA As Integer, ByVal iB As Integer) As Integer
    'Returns iA mod iB in RealMod() as an integer. Good for small values.
    'Normally Mod takes on the sign of iA but here
    'negative values are increased by iB until result is positive.
    'Credit to Rebecca Gabriella's String Math Module with added edits.
    'https://cosxoverx.livejournal.com/47220.html
        
    If iB = 0 Then
        MsgBox "Divide by zero in RealMod()"
        Exit Function
    End If
    
    If iA Mod iB = 0 Then
        RealMod = 0
    ElseIf iA < 0 Then
        RealMod = iB + iA Mod iB 'increase till pos
    Else
        RealMod = iA Mod iB
    End If

End Function

Private Function RealDiv(ByVal iA As Integer, ByVal iB As Integer) As Integer
    'Returns integer division iA divided by iB in RealDiv().Good for small values.
    'Credit to Rebecca Gabriella's String Math Module with added edits.
    'https://cosxoverx.livejournal.com/47220.html
    
    If iB = 0 Then
        MsgBox "Divide by zero in RealDiv()"
        Exit Function
    End If
    
    If iA Mod iB = 0 Then
        RealDiv = iA \ iB
    ElseIf iA < 0 Then
        RealDiv = iA \ iB - 1 'round down
    Else
        RealDiv = iA \ iB
    End If

End Function

Public Function Subtract(ByVal sA As String, ByVal sB As String) As String
    'Parameters are string integers of any length, for example "-345...", "973..."
    'Returns sA minus sB as string integer in Subtract()
    'Credit to Rebecca Gabriella's String Math Module with added edits
    'https://cosxoverx.livejournal.com/47220.html
    
    Dim bAN As Boolean, bBN As Boolean, bRN As Boolean
    Dim iA As Integer, iB As Integer, iComp As Integer
    
    'test for empty parameters
    If Len(sA) = 0 Or Len(sB) = 0 Then
        MsgBox "Empty parameter in Subtract()"
        Exit Function
    End If
        
    'handle some negative values with Add()
    bAN = (Left(sA, 1) = "-")
    bBN = (Left(sB, 1) = "-")
    If bAN Then sA = Mid(sA, 2)
    If bBN Then sB = Mid(sB, 2)
    If bAN And bBN Then
        bRN = True
    ElseIf bBN Then
        Subtract = Add(sA, sB)
        Exit Function
    ElseIf bAN Then
        Subtract = "-" + Add(sA, sB)
        Exit Function
    Else
        bRN = False
    End If
    
    'get biggest value into variable sA
    iComp = Compare(sA, sB)
    If iComp = 0 Then     'parameters equal in size
        Subtract = "0"
        Exit Function
    ElseIf iComp < 0 Then 'sA < sB
        Subtract = sA     'so swop sA and sB
        sA = sB           'to ensure sA >= sB
        sB = Subtract
        bRN = Not bRN     'and reverse output sign
    End If
    iA = Len(sA)          'recheck lengths
    iB = Len(sB)
    iComp = 0
    Subtract = ""
        
    'subtract column by column
    Do While iA > 0 And iB > 0
        iComp = iComp + CInt(Mid(sA, iA, 1)) - CInt(Mid(sB, iB, 1))
        Subtract = CStr(RealMod(iComp, 10)) + Subtract
        iComp = RealDiv(iComp, 10)
        iA = iA - 1
        iB = iB - 1
    Loop
    'then assuming param sA is longer
    Do While iA > 0
        iComp = iComp + CInt(Mid(sA, iA, 1))
        Subtract = CStr(RealMod(iComp, 10)) + Subtract
        iComp = RealDiv(iComp, 10)
        iA = iA - 1
    Loop
    
    'remove any leading zeros from result
    Do While Len(Subtract) > 1 And Left(Subtract, 1) = "0"
        Subtract = Mid(Subtract, 2)
    Loop
    
    'decide about any negative signs
    If Subtract <> "0" And bRN Then
        Subtract = "-" + Subtract
    End If

End Function

Public Function Multiply(ByVal sA As String, ByVal sB As String) As String
    'Parameters are string integers of any length, for example "-345...", "973..."
    'Returns sA times sB as string integer in Multiply()
    'Credit to Rebecca Gabriella's String Math Module with added edits
    'https://cosxoverx.livejournal.com/47220.html
    
    Dim bAN As Boolean, bBN As Boolean, bRN As Boolean
    Dim m() As Long, iCarry As Long
    Dim iAL As Integer, iBL As Integer, iA As Integer, iB As Integer
        
    'test for empty parameters
    If Len(sA) = 0 Or Len(sB) = 0 Then
        MsgBox "Empty parameter in Multiply()"
        Exit Function
    End If
        
    'handle any negative signs
    bAN = (Left(sA, 1) = "-")
    bBN = (Left(sB, 1) = "-")
    If bAN Then sA = Mid(sA, 2)
    If bBN Then sB = Mid(sB, 2)
    bRN = (bAN <> bBN)
    iAL = Len(sA)
    iBL = Len(sB)
    
    'perform long multiplication without carry in notional columns
    ReDim m(1 To (iAL + iBL - 1)) 'expected length of product
    For iA = 1 To iAL
        For iB = 1 To iBL
            m(iA + iB - 1) = m(iA + iB - 1) + CLng(Mid(sA, iAL - iA + 1, 1)) * CLng(Mid(sB, iBL - iB + 1, 1))
        Next iB
    Next iA
    iCarry = 0
    Multiply = ""
    
    'add up column results with carry
    For iA = 1 To iAL + iBL - 1
        iCarry = iCarry + m(iA)
        Multiply = CStr(iCarry Mod 10) + Multiply
        iCarry = iCarry \ 10
    Next iA
    Multiply = CStr(iCarry) + Multiply
    
    'remove any leading zeros
    Do While Len(Multiply) > 1 And Left(Multiply, 1) = "0"
        Multiply = Mid(Multiply, 2)
    Loop
    
    'decide about any negative signs
    If Multiply <> "0" And bRN Then
        Multiply = "-" + Multiply
    End If

End Function

Public Function PartialDivide(ByVal sA As String, ByVal sB As String) As PartialDivideInfo
    'Called only by Divide() to assist in fitting trials for long division
    'All of Quotient, Subtrahend, and Remainder are returned as elements of type PartialDivideInfo
    'Credit to Rebecca Gabriella's String Math Module with added edits
    'https://cosxoverx.livejournal.com/47220.html
        
    For PartialDivide.Quotient = 9 To 1 Step -1                                'propose a divisor to fit
        PartialDivide.Subtrahend = Multiply(sB, CStr(PartialDivide.Quotient))  'test by multiplying it out
        If Compare(PartialDivide.Subtrahend, sA) <= 0 Then                     'best fit found
            PartialDivide.Remainder = Subtract(sA, PartialDivide.Subtrahend)   'get remainder
            Exit Function                                                      'exit with best fit details
        End If
    Next PartialDivide.Quotient
    
    'no fit found, divisor too big
    PartialDivide.Quotient = 0
    PartialDivide.Subtrahend = "0"
    PartialDivide.Remainder = sA

End Function

Public Function Divide(ByVal sA As String, ByVal sB As String) As String
    'Parameters are string integers of any length, for example "-345...", "973..."
    'Returns sA divided by sB as string integer in Divide()
    'The remainder is available as sLastRemainder at Module level
    'Credit to Rebecca Gabriella's String Math Module with added edits
    'https://cosxoverx.livejournal.com/47220.html
    
    Dim bAN  As Boolean, bBN As Boolean, bRN As Boolean
    Dim iC As Integer
    Dim s As String
    Dim d As PartialDivideInfo
    
    'test for empty parameters
    If Len(sA) = 0 Or Len(sB) = 0 Then
        MsgBox "Empty parameter in Divide()"
        Exit Function
    End If
    
    bAN = (Left(sA, 1) = "-") 'true for neg
    bBN = (Left(sB, 1) = "-")
    If bAN Then sA = Mid(sA, 2) 'take two charas if neg
    If bBN Then sB = Mid(sB, 2)
    bRN = (bAN <> bBN)
    If Compare(sB, "0") = 0 Then
        Err.Raise 11
        Exit Function
    ElseIf Compare(sA, "0") = 0 Then
        Divide = "0"
        sLastRemainder = "0"
        Exit Function
    End If
    iC = Compare(sA, sB)
    If iC < 0 Then
        Divide = "0"
        sLastRemainder = sA
        Exit Function
    ElseIf iC = 0 Then
        If bRN Then
            Divide = "-1"
        Else
            Divide = "1"
        End If
        sLastRemainder = "0"
        Exit Function
    End If
    Divide = ""
    s = ""
    
    'Long division method
    For iC = 1 To Len(sA)
        'take increasing number of digits
        s = s + Mid(sA, iC, 1)
        d = PartialDivide(s, sB) 'find best fit
        Divide = Divide + CStr(d.Quotient)
        s = d.Remainder
    Next iC
    
    'remove any leading zeros
    Do While Len(Divide) > 1 And Left(Divide, 1) = "0"
        Divide = Mid(Divide, 2)
    Loop
    
    'decide about the signs
    If Divide <> "0" And bRN Then
        Divide = "-" + Divide
    End If
    
    sLastRemainder = s 'string integer remainder

End Function

Public Function LastModulus() As String
    LastModulus = sLastRemainder
End Function

Public Function Modulus(ByVal sA As String, ByVal sB As String) As String
    Divide sA, sB
    Modulus = sLastRemainder
End Function

Public Function BigIntFromString(ByVal sIn As String, ByVal iBaseIn As Integer) As String
    'Returns base10 integer string from sIn of different base (iBaseIn).
    'Example for sIn = "1A" and iBaseIn = 16, returns the base10 result 26.
    'Credit to Rebecca Gabriella's String Math Module with added edits
    'https://cosxoverx.livejournal.com/47220.html
            
    Dim bRN As Boolean
    Dim sBS As String
    Dim iP As Integer, iV As Integer
    
    'test for empty parameters
    If Len(sIn) = 0 Or iBaseIn = 0 Then
        MsgBox "Bad parameter in BigIntFromString()"
        Exit Function
    End If
        
    'handle negative signs
    If Left(sIn, 1) = "-" Then
        bRN = True
        sIn = Mid(sIn, 2)
    Else
        bRN = False
    End If
    sBS = CStr(iBaseIn)
    
    BigIntFromString = "0"
    For iP = 1 To Len(sIn)
        'use constant list position and base for conversion
        iV = InStr(Alphabet, UCase(Mid(sIn, iP, 1)))
        If iV > 0 Then 'accumulate
            BigIntFromString = Multiply(BigIntFromString, sBS)
            BigIntFromString = Add(BigIntFromString, CStr(iV - 1))
        End If
    Next iP
    
    'decide on any negative signs
    If bRN Then
        BigIntFromString = "-" + BigIntFromString
    End If

End Function

Public Function BigIntToString(ByVal sIn As String, ByVal iBaseOut As Integer) As String
    'Returns integer string of specified iBaseOut (iBaseOut) from base10 (sIn) integer string.
    'Example for sIn = "26" and iBaseOut = 16, returns the output "1A".
    'Credit to Rebecca Gabriella'sIn String Math Module with added edits
    'https://cosxoverx.livejournal.com/47220.html
            
    Dim bRN As Boolean
    Dim sB As String
    Dim iV As Integer
    
    'test for empty parameters
    If Len(sIn) = 0 Or iBaseOut = 0 Then
        MsgBox "Bad parameter in BigIntToString()"
        Exit Function
    End If
    
    'handle negative signs
    If Left(sIn, 1) = "-" Then
        bRN = True
        sIn = Mid(sIn, 2)
    Else
        bRN = False
    End If
    sB = CStr(iBaseOut)
    
    BigIntToString = ""
    Do While Compare(sIn, "0") > 0
        sIn = Divide(sIn, sB)
        iV = CInt(LastModulus())
        'locates appropriate alphabet character
        BigIntToString = Mid(Alphabet, iV + 1, 1) + BigIntToString
    Loop
    
    'decide on any negative signs
    If BigIntToString = "" Then
        BigIntToString = "0"
    ElseIf BigIntToString <> "0" And bRN Then
        BigIntToString = "-" + BigIntToString
    End If

End Function

Added Big Math Fuctions

• Factorial() makes use of Multiply() and other integer math functions of the main module. It is of course fairly slow but is not otherwise limited in any practical way. The code has been arbitrarily limited to calculating values up to 1000!, but this can be adjusted by the user. DoEvents is important here, since it allows breaking the run if an unwise attempt is made. Reciprocal factorials and negative factorials are not handled here.
• IntStrByExp() raises integer strings to an exponent. Again, negative exponents cannot yet be handled in this procedure, though the number to raise can take a negative value.

Sub testFactorial()
   'Run this to test factorial
      
   Dim sIn As Integer, sOut As String
   
   sIn = "400"
   sOut = Factorial(sIn)
   
   'output Immediate Window
   Debug.Print sIn & "!" & vbCrLf & _
               sOut & vbCrLf & _
               Len(sOut) & " digits" & vbCrLf
   
   'output message box - short output
   'MsgBox sIn & "!" & vbcrlf & _
           sOut & vbCrLf & _
           Len(sOut) &  " digits" & vbCrLf

End Sub

Function Factorial(ByVal sA As String) As String
    'Returns integer string factorial for integer string parameter sA
    '2000! in 30 secs (5736 digits); 1000! in six seconds (2568 digits)
    '400! in one second (869 digits);100! pdq (158 digits).
    'Arbitrarily set max sA = "1000"
    
    Dim iC As Integer
        
    'avoid excessively long runs
    If CInt(sA) >= 1000 Then
        MsgBox "Run time too long - closing."
        Factorial = "Error - Run time too long"
        Exit Function
    End If
        
    iC = CInt(sA)
    Factorial = "1"
    
    'run factorial loop
    Do Until iC <= 0
        DoEvents 'permits break key use
        Factorial = Multiply(Factorial, iC)
        iC = iC - 1
    Loop

End Function

Sub testIntStrByExp()
   'Run this to test IntStrByExp
      
   Dim sIn As String, sOut As String, iExp As Integer, bA As Boolean
   Dim nL As Integer
   
   
   sIn = "-123456789123456789"
   iExp = 7
   
   sOut = IntStrByExp(sIn, iExp)
   nL = Len(sOut)
   If Left(sOut, 1) = "-" Then
   nL = nL - 1
   End If
   
   'output Immediate Window
   Debug.Print sIn & "^" & iExp & " equals" & vbCrLf & _
               sOut & vbCrLf & _
               nL & " digits out" & vbCrLf
   
   'output message box - short output
   MsgBox sIn & "^" & iExp & " equals" & vbCrLf & _
               sOut & vbCrLf & _
               nL & " digits out" & vbCrLf

End Sub

Function IntStrByExp(ByVal sA As String, ByVal iExp As Integer) As String
    'Returns integer string raised to exponent iExp as integer string
    'Assumes posiive exponent, and pos or neg string integer
    
    Dim bA As Boolean, bR As Boolean
    
    'check parameter
    If iExp < 0 Then
        MsgBox "Cannot handle negative powers yet"
        Exit Function
    End If
    
    'handle any negative signs
    bA = (Left(sA, 1) = "-")
    If bA Then sA = Mid(sA, 2) Else sA = Mid(sA, 1)
    If bA And RealMod(iExp, 2) <> 0 Then bR = True
    
    'run multiplication loop
    IntStrByExp = "1"
    Do Until iExp <= 0
        DoEvents 'permits break key use
        IntStrByExp = Multiply(IntStrByExp, sA)
        iExp = iExp - 1
    Loop

    'remove any leading zeros
    Do While Len(IntStrByExp) > 1 And Left(IntStrByExp, 1) = "0"
        IntStrByExp = Mid(IntStrByExp, 2)
    Loop
    
    'decide on any signs
    If IntStrByExp <> "0" And bR Then
       IntStrByExp = "-" & IntStrByExp
    End If

End Function

External Links

• Rebecca Gabriella's String Math Module: Big Integer Library for VBA (Visual Basic for Applications).