Leading the way in Microsoft Office Development
 Home|Excel|Word|PowerPoint|Consultancy|Feedback|Contact 
 Microsoft Excel > Functions User Defined > SPELLNUMBER< Previous | Next > 

 

SPELLNUMBER(dbMyNumber, sMainUnitPlural, sMainUnitSingle [,sDecimalUnitPlural] [,sDecimalUnitSingle])

 
 

Returns the word equivalent for a numerical number.

 

 
dbMyNumberThe number you want to convert to text.
sMainUnitPluralThe unit to use for whole numbers.
sMainUnitSingleThe unit to use for single whole numbers.
sDecimalUnitPluralThe unit to use for decimal values.
sDecimalUnitSingleThe unit to use for single decimal values.
 

 

REMARKS

 
 
  • This function returns the same value for positive and negative numbers.

     
     
  • All numbers will be rounded to the nearest 2 decimal places.

     
     
  • This function will only return the correct text for numbers less than 999,999,999,999,999 (nine hundred trillion).

     
     
  • Thanks to www.sulprobil.com - Bernd Plumhoff for correcting this function.

     

     
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    Option Explicit

    Public Function SPELLNUMBER(ByVal dbMyNumber As Double, _
                                ByVal sMainUnitPlural As String, _
                                ByVal sMainUnitSingle As String, _
                       Optional ByVal sDecimalUnitPlural As String = "", _
                       Optional ByVal sDecimalUnitSingle As String = "")

       Dim sMyNumber As String
       Dim sCurrency As String
       Dim sDecimalText As String
       Dim sTemp As String
       Dim iDecimalPlace As Integer
       Dim iCount As Integer
        
       Call Application.Volatile(True)

       ReDim Place(9) As String
       Application.Volatile (True)
       Place(2) = "Thousand"
       Place(3) = "Million"
       Place(4) = "Billion"
       Place(5) = "Trillion"
       sMyNumber = Trim(CStr(dbMyNumber))
       iDecimalPlace = InStr(dbMyNumber, ".")

       If iDecimalPlace > 0 Then
          sDecimalText = GetTens(Left(Mid(Round(sMyNumber, 2), iDecimalPlace + 1) & "00", 2))
          If Len(sDecimalText) > 0 Then
             sMyNumber = Trim(Left(sMyNumber, iDecimalPlace - 1))
          Else
             sMyNumber = ""
          End If
       End If
       iCount = 1
       Do While sMyNumber <> ""
           sTemp = GetHundreds(sMyNumber, Right(sMyNumber, 3), iDecimalPlace)
           If sTemp <> "" Then
              If (iCount > 1) And (LCase(Left(Trim(sCurrency), 3)) <> "and") Then
                 sCurrency = ", " & sCurrency
              End If
              sCurrency = sTemp & Place(iCount) & sCurrency
           End If
           If Len(sMyNumber) > 3 Then
               sMyNumber = Left(sMyNumber, Len(sMyNumber) - 3)
           Else
               sMyNumber = ""
           End If
           iCount = iCount + 1
       Loop
       Select Case Trim(sCurrency)
           Case "": sCurrency = "No " & sMainUnitPlural
           Case "One": sCurrency = "One " & sMainUnitSingle
           Case Else: sCurrency = sCurrency & sMainUnitPlural
       End Select
       If iDecimalPlace > 0 Then
           If (Len(sDecimalUnitPlural) > 0 And Len(sDecimalUnitSingle) > 0) Then
              sCurrency = sCurrency & ", "
               Select Case Trim(sDecimalText)
                   Case "": sDecimalText = "No " & sDecimalUnitPlural
                   Case "One": sDecimalText = "One " & sDecimalUnitSingle
                   Case Else: sDecimalText = sDecimalText & sDecimalUnitPlural
               End Select
           Else
           sCurrency = sCurrency & " and "
           sDecimalText = Mid(Trim(Str(dbMyNumber)), iDecimalPlace + 1) & "/100"
           End If
       End If
       SPELLNUMBER = Trim(sCurrency & sDecimalText)
    End Function
       

     
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    Function GetHundreds(ByVal sMyNumber As String, _
                         ByVal sHundredNumber As String, _
                         ByVal iDecimal As Integer) As String

        Dim sResult As String
        
        If sHundredNumber = "0" Then Exit Function
        sHundredNumber = Right("000" & sHundredNumber, 3)
        If Mid(sHundredNumber, 1, 1) <> "0" Then
            sResult = GetDigit(Mid(sHundredNumber, 1, 1)) & "Hundred"
        End If
        If (sMyNumber > 1000) And (Mid(sHundredNumber, 3, 1) <> "0" Or _
                                   Mid(sHundredNumber, 2, 1) <> "0") Or _
           (Len(sResult) > 0) And (Mid(sHundredNumber, 3, 1) <> "0" Or _
                                   Mid(sHundredNumber, 2, 1) <> "0") Then
           sResult = sResult & " and "
        End If
        If Mid(sHundredNumber, 2, 1) <> "0" Then
           sResult = sResult & GetTens(Mid(sHundredNumber, 2))
        Else
           If Mid(sHundredNumber, 3, 1) <> "0" Then
              sResult = sResult & GetDigit(Mid(sHundredNumber, 3))
           Else
              sResult = sResult & " "
           End If
        End If
        GetHundreds = sResult
    End Function
       

     
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    Function GetTens(ByVal sTensText As String) As String

        Dim sResult As String

        sResult = ""
        If Left(sTensText, 1) = 1 Then
            Select Case sTensText
                Case "10": sResult = "Ten "
                Case "11": sResult = "Eleven "
                Case "12": sResult = "Twelve "
                Case "13": sResult = "Thirteen "
                Case "14": sResult = "Fourteen "
                Case "15": sResult = "Fifteen "
                Case "16": sResult = "Sixteen "
                Case "17": sResult = "Seventeen"
                Case "18": sResult = "Eighteen "
                Case "19": sResult = "Nineteen "
                Case Else
            End Select
        Else
            Select Case Left(sTensText, 1)
                Case "2": sResult = "Twenty "
                Case "3": sResult = "Thirty "
                Case "4": sResult = "Forty "
                Case "5": sResult = "Fifty "
                Case "6": sResult = "Sixty "
                Case "7": sResult = "Seventy "
                Case "8": sResult = "Eighty "
                Case "9": sResult = "Ninety "
                Case Else
            End Select
            sResult = sResult & GetDigit(Right(sTensText, 1))
        End If
        GetTens = sResult
    End Function
       

     
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    Function GetDigit(ByVal sDigit As String) As String
        Select Case sDigit
            Case "1": GetDigit = "One "
            Case "2": GetDigit = "Two "
            Case "3": GetDigit = "Three "
            Case "4": GetDigit = "Four "
            Case "5": GetDigit = "Five "
            Case "6": GetDigit = "Six "
            Case "7": GetDigit = "Seven "
            Case "8": GetDigit = "Eight "
            Case "9": GetDigit = "Nine "
            Case Else: GetDigit = ""
        End Select
    End Function
       

     

    Example

     
       

     Copyright © 2004-2007 Better Solutions Limited. All Rights Reserved.< Previous | Top | Next >