Forum Discussion

1 Reply

  • Mazzon1195 

    See if this does what you want:

    Function SpellNumber(ByVal MyNumber As Variant) As String
        Dim Dollars As String, Cents As String, Temp
        Dim DecimalPlace As Long, Count As Long
        Dim Minus
        ReDim Place(9) As String
        Place(2) = " Thousand "
        Place(3) = " Million "
        Place(4) = " Billion "
        Place(5) = " Trillion "
        If MyNumber < 0 Then
            Minus = "Minus "
        End If
        ' String representation of amount.
        If TypeName(MyNumber) = "Range" Then
            MyNumber = Replace(Trim(MyNumber.Text), _
                Application.International(xlThousandsSeparator), "")
        Else
            MyNumber = Replace(Trim(CStr(MyNumber)), _
                Application.International(xlThousandsSeparator), "")
        End If
        ' Position of decimal place 0 if none.
        DecimalPlace = InStr(MyNumber, Application.International(xlDecimalSeparator))
        ' Convert cents and set MyNumber to dollar amount.
        If DecimalPlace > 0 Then
            Cents = " Point " & SpellDigits(Mid(MyNumber, DecimalPlace + 1))
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
        End If
        Count = 1
        Do While MyNumber <> ""
            Temp = GetHundreds(Right(MyNumber, 3))
            If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
            If Len(MyNumber) > 3 Then
                MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
                MyNumber = ""
            End If
            Count = Count + 1
        Loop
        Select Case Dollars
            Case ""
                Dollars = "Zero"
        End Select
        SpellNumber = Minus & Dollars & Cents
    End Function
    
    ' Converts a number from 100-999 into text
    Function GetHundreds(ByVal MyNumber As String) As String
        Dim Result As String
        If Val(MyNumber) = 0 Then Exit Function
        MyNumber = Right("000" & MyNumber, 3)
        ' Convert the hundreds place.
        If Mid(MyNumber, 1, 1) <> "0" Then
            Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
        End If
        ' Convert the tens and ones place.
        If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & GetTens(Mid(MyNumber, 2))
        Else
            Result = Result & GetDigit(Mid(MyNumber, 3))
        End If
        GetHundreds = Result
    End Function
    
    ' Converts a number from 10 to 99 into text.
    Function GetTens(TensText As String) As String
        Dim Result As String
        Result = ""           ' Null out the temporary function value.
        If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
            Select Case Val(TensText)
                Case 10: Result = "Ten"
                Case 11: Result = "Eleven"
                Case 12: Result = "Twelve"
                Case 13: Result = "Thirteen"
                Case 14: Result = "Fourteen"
                Case 15: Result = "Fifteen"
                Case 16: Result = "Sixteen"
                Case 17: Result = "Seventeen"
                Case 18: Result = "Eighteen"
                Case 19: Result = "Nineteen"
                Case Else
            End Select
        Else                                 ' If value between 20-99...
            Select Case Val(Left(TensText, 1))
                Case 2: Result = "Twenty "
                Case 3: Result = "Thirty "
                Case 4: Result = "Forty "
                Case 5: Result = "Fifty "
                Case 6: Result = "Sixty "
                Case 7: Result = "Seventy "
                Case 8: Result = "Eighty "
                Case 9: Result = "Ninety "
                Case Else
            End Select
            Result = Result & GetDigit _
                (Right(TensText, 1))  ' Retrieve ones place.
        End If
        GetTens = Result
    End Function
    
    ' Converts a number from 1 to 9 into text.
    Function GetDigit(Digit As String, Optional ShowZero As Boolean) As String
        Select Case Val(Digit)
            Case 0
                If ShowZero Then
                    GetDigit = "Zero"
                End If
            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"
        End Select
    End Function
    
    ' Spells digits
    Function SpellDigits(s As String) As String
        Dim i As Long
        Dim Result As String
        For i = 1 To Len(s)
            Result = Result & " " & GetDigit(Mid(s, i, 1), True)
        Next i
        SpellDigits = Trim(Result)
    End Function

    Use like this in a cell formula:

     

    =SpellNumber(A1)

Resources