Creating user-defined Excel functions (UDFs) – Part 2. Improved VBA code to spell a number in a text form.

         In the previous post, we created Excel UDF, which translates a number into a text form, using Dollar/Cents as default currency type. We strictly relied on VBA code snippet, published on Microsoft’s knowledge base. While working with this code, we now realize that several enhancements to this UDF would be desirable.

         First of all, when dealing with even amounts, we really don’t see a point of quite redundant“No Cents” message. Secondly, it appears that this code simply formats the amount specified, instead of rounding it. As an example $ 1,256.8789 will be spelled out as One Thousand Two Hundred Fifty Six Dollars and Eighty Seven Cents, but it really should be: One Thousand Two Hundred Fifty Six Dollars and Eighty Eight Cents. Next, we probably want to change our function name to reflect the fact it only translates dollar amounts, not any other currencies, nor non-currency amounts. This is definitely a matter of personal taste, but let’s call this function SpellNumberDollar and while at it, let’s change it’s input variable from MyNumber to Amount. Let’s then create a new universal UDF (SpellNumberCurrency), which could accept any currency type, instead of limiting ourselves to dollars. After all, we don’t have anything against Euros, do we? Finally, let’s write a true SpellNumber function, to spell out a non-currency number up to the third decimal point (thousandths), instead of current precision of two decimal points (hundredths.)

         Let’s start with renaming our function and changing it’s parameter name:

Function SpellNumber(ByVal MyNumber) 

         needs to be changed to:

Function SpellNumberDollar(ByVal Amount) 

         Within our module, we now need to replace one occurrence of SpellNumber with SpellNumberDollar and multiple occurrences of MyNumber with Amount.

         To rid off the “No Cents” message, we simply need to replace one line of code

Cents = " and No Cents" 

          with the folllowing:

Cents = "" 

         Now, we can use ROUND function to properly display the cents portion of our amount:

Amount = Trim(Str(Amount)) 

          becomes:

Amount = Round(Trim(Str(Amount)), 2) 

          To test all changes made, we now should be able to see function results as illustrated below:

          Should your results differ, you can check your code to ensure that it conforms with desired code:

'Original function created by Microsoft, 
'renamed to better describe it's purpose:
'Spell out any currency amounts in dollars and cents
Function SpellNumberDollar(ByVal Amount)
    Dim Dollars, Cents, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "
    
    ' String representation of the amount
    ' Small change to round the amount of currency used to 2 decimals
    ' By Excel Strategies, LLC
    Amount = Round(Trim(Str(Amount)), 2)
    
    ' Position of decimal place, 0 if none
    DecimalPlace = InStr(Amount, ".")
    ' Convert cents and set Amount to dollar amount
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(Amount, DecimalPlace + 1) & _
                  "00", 2))
        Amount = Trim(Left(Amount, DecimalPlace - 1))
    End If
    Count = 1
    Do While Amount <> ""
        Temp = GetHundreds(Right(Amount, 3))
        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
        If Len(Amount) > 3 Then
            Amount = Left(Amount, Len(Amount) - 3)
        Else
            Amount = ""
        End If
        Count = Count + 1
    Loop
    Select Case Dollars
        Case ""
            Dollars = "No Dollars"
        Case "One"
            Dollars = "One Dollar"
         Case Else
            Dollars = Dollars & " Dollars"
    End Select
    Select Case Cents
        Case ""
            Cents = ""
        Case "One"
            Cents = " and One Cent"
              Case Else
            Cents = " and " & Cents & " Cents"
    End Select
    SpellNumberDollar = Dollars & Cents
End Function

          Notice, that if you happen to be proficient with built-in Excel functions, Excel makes it very simple to use their VBA equivalents. Since we are only beginning our VBA travels, let’s not worry about typical rookie mistakes: implicit declaration of variables, reusing variables, absence of any error handling routines, and so forth.

          To create universal currency function, we now want to replace this code line

 Function SpellNumberDollar(ByVal Amount) 

          with the one asking for additional currency parameters:

 SpellNumberCurrency(ByVal Amount, strDollars, strCents) 

          To perform actual currency string manipulation, below code excerpt

    Select Case Dollars
        Case ""
            Dollars = "No Dollars"
        Case "One"
            Dollars = "One Dollar"
         Case Else
            Dollars = Dollars & " Dollars"
    End Select
    Select Case Cents
        Case ""
            Cents = ""
        Case "One"
            Cents = " and One Cent"
              Case Else
            Cents = " and " & Cents & " Cents"
    End Select

          should be changed to:

    Select Case Dollars
        Case ""
            Dollars = ""
        Case "One"
            Dollars = "One " & Left(strDollars, Len(strDollars) - 1)
         Case Else
            Dollars = Dollars & " " & strDollars
    End Select
    Select Case Cents
        Case ""
            Cents = ""
        Case "One"
            Cents = " and One " & Left(strCents, Len(strCents) - 1)
              Case Else
            Cents = " and " & Cents & " " & strCents
    End Select

         Once again, this code should be rather self-explanatory for anyone who has done text manipulation via built-in Excel functions (LEFT, LEN, &…) Basically, we are passing currency parameters (strDollars and strCents) instead of hard-coding “Dollars” and “Cents” as in previous example. Additionally, to ensure proper singular form spelling, we are eliminating last letter in both parameters (typically letter ‘s’.)
         Let’s test this function to convert numbers denominated in different world currencies:

         The last UDF we will create today is true SpellNumber function. Our goal is to spell out a non-currency amount with a precision set up to the third decimal point (thousandths.) :

         We will use below VBA code to generate this UDF:

'Modified version of Microsoft function
'By Excel Strategies, LLC
'This function spells out any number with a precision of up
'to 3 decimal places (enhancement over 2 decimal places)
Public Function SpellNumber(ByVal Amount)
    
    'Define variables
    Dim Numbers, Numbers2, Decimals, Decimals2, Temp, Temp2
    Dim DecimalPlace, Count
    
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "
    
    'String representation of amount, that also rounds it
    'up to 3 decimal places
    Amount = Round(Trim(Str(Amount)), 3)
    'Position of decimal place: 0 if none.
    DecimalPlace = InStr(Amount, ".")
    
    ' Convert decimals and set Amount to whole amount.
    If DecimalPlace > 0 Then
        'All numbers after period, if any
        Decimals = Right(Amount, Len(Amount) - DecimalPlace)
        'Precision level of the number (0-3)
        Decimals2 = Len(Decimals)
        'Whole number (digits to the left of perido)
        Amount = Trim(Left(Amount, DecimalPlace - 1))
                
        'Spell out hundreds/tens in the decimal portion
        Do While Decimals <> ""
                Temp2 = GetHundreds(Right(Decimals, 3))
            If Temp2 <> "" Then Numbers2 = Temp2 & Place(Count) & Numbers2
            If Len(Decimals) > 3 Then
                Decimals = Left(Decimals, Len(Decimals) - 3)
            Else
                Decimals = ""
            End If
            Count = Count + 1
        Loop
    End If
    
    Count = 1
    'Spell out hundreds/tens in the amount
    Do While Amount <> ""
        Temp = GetHundreds(Right(Amount, 3))
        If Temp <> "" Then Numbers = Temp & Place(Count) & Numbers
        If Len(Amount) > 3 Then
            Amount = Left(Amount, Len(Amount) - 3)
        Else
            Amount = ""
        End If
        Count = Count + 1
    Loop
    
    'Construct number/whole portion
    Select Case Numbers
        Case ""
            Numbers = "Not a number"
        Case "One"
            Numbers = "One"
        Case Else
            Numbers = Numbers
    End Select
    
    'Construct decimal portion
    Select Case Numbers2
        Case ""
            Numbers2 = ""
        Case 0
            Numbers2 = ""
        Case Else
            Numbers2 = " and " & Numbers2
    End Select
    
    'Add appropriate suffix to the decimal portion
    Select Case Decimals2
        Case 0
            Decimals = ""
        Case 1
            Decimals = " Tenths"
        Case 2
            Decimals = " Hundredths"
        Case Is > 2
            Decimals = " Thousandths"
        Case Else
            Decimals = ""
    End Select
    
    'Concatenate all variables into one master answer
    SpellNumber = Numbers & Numbers2 & Decimals
   
End Function

         For your convenience, you can download revised Excel file and start using all three functions right away.