# Spell Numbers Including Decimcal Places (3 Digits)

• ### Question

• Hi,

I want to spell the numbers like,

1234.001 as "One Thousand Two Hundred Thirty Four And One "

1234.010 as "One Thousand Two Hundred Thirty Four And Ten "

1234.100 as "One Thousand Two Hundred Thirty Four And One Hundred "

1234.110 as "One Thousand Two Hundred Thirty Four And One Hundred Ten "

1234.101 as "One Thousand Two Hundred Thirty Four And One Hundred One "

1234.121 as "One Thousand Two Hundred Thirty Four And One Hundred Twenty One "

Wednesday, June 24, 2015 11:56 AM

• =SpellNumber(INT(A1)) & " And " & SpellNumber(ROUND(MOD(A1,1)*1000,0))

```'http://support.microsoft.com/kb/213360
Option Explicit

Sub Example_SpellNumber()
Debug.Print SpellNumber(1, , True, "Point")
End Sub

Function SpellNumber(ByVal MyNumber, _
Optional ByVal SpellSingleDigitsBefore As Boolean, _
Optional ByVal SpellSingleDigitsAfter As Boolean, _
Optional ByVal DotWord As String, _
Optional ByVal CurrencyBefore As String, _
Optional ByVal CurrencyAfter As String)
Dim DigitsBefore As String, DigitsAfter As String
Dim Temp As String
Dim i As Long, j As Long

ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "

'Strip blanks
If VarType(MyNumber) <> vbString Then MyNumber = Str(MyNumber)
If InStr(MyNumber, " ") > 0 Then MyNumber = Replace\$(MyNumber, " ", "")

'Process decimal places first
i = InStr(MyNumber, ".")
If i > 0 Then
If SpellSingleDigitsAfter Then
DigitsAfter = Mid(MyNumber, i + 1)
For j = 1 To Len(DigitsAfter)
Temp = Temp & " " & GetDigit(Mid(DigitsAfter, j, 1), True)
Next
DigitsAfter = Temp
Else
DigitsAfter = " " & GetTens(Left(Mid(MyNumber, i + 1) & "00", 2))
End If
MyNumber = Trim(Left(MyNumber, i - 1))
End If

i = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then DigitsBefore = Temp & Place(i) & DigitsBefore
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
i = i + 1
Loop

If Len(CurrencyBefore) > 0 Then
Select Case DigitsBefore
Case ""
DigitsBefore = "No " & CurrencyBefore & "s"
Case "One"
DigitsBefore = "One " & CurrencyBefore
Case Else
DigitsBefore = DigitsBefore & " " & CurrencyBefore & "s"
End Select
Else
Select Case DigitsBefore
Case ""
DigitsBefore = "Zero"
End Select
End If
If Len(CurrencyAfter) > 0 Then
Select Case DigitsAfter
Case ""
DigitsAfter = " and No " & CurrencyAfter & "s"
Case "One"
DigitsAfter = " and One " & CurrencyAfter
Case Else
DigitsAfter = " and " & DigitsAfter & " " & CurrencyAfter
End Select
ElseIf Len(DotWord) Then
DigitsAfter = " " & DotWord & DigitsAfter
End If

SpellNumber = DigitsBefore & DigitsAfter

'Strip double blanks
Do While InStr(SpellNumber, "  ") > 0
SpellNumber = Replace(SpellNumber, "  ", " ")
Loop
End Function

Function GetHundreds(ByVal MyNumber As String) As String
'Converts a number from 100-999 into text
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

Function GetTens(ByVal TensText As String) As String
'Converts a number from 10 to 99 into text.
Dim Result As String
'If value between 10-19...
If Val(Left(TensText, 1)) = 1 Then
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
'Retrieve ones place.
Result = Result & GetDigit(Right(TensText, 1))
End If
GetTens = Result
End Function

Function GetDigit(ByVal Digit As String, _
Optional ByVal SpellZero As Boolean) As String
'Converts a number from 0 to 9 into text.
Select Case Val(Digit)
Case 0: If SpellZero Then GetDigit = "Zero"
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
```

• Edited by Wednesday, June 24, 2015 12:31 PM
• Proposed as answer by Thursday, June 25, 2015 1:38 AM
• Marked as answer by Wednesday, July 1, 2015 8:25 AM
Wednesday, June 24, 2015 12:31 PM

### All replies

• =SpellNumber(INT(A1)) & " And " & SpellNumber(ROUND(MOD(A1,1)*1000,0))

```'http://support.microsoft.com/kb/213360
Option Explicit

Sub Example_SpellNumber()
Debug.Print SpellNumber(1, , True, "Point")
End Sub

Function SpellNumber(ByVal MyNumber, _
Optional ByVal SpellSingleDigitsBefore As Boolean, _
Optional ByVal SpellSingleDigitsAfter As Boolean, _
Optional ByVal DotWord As String, _
Optional ByVal CurrencyBefore As String, _
Optional ByVal CurrencyAfter As String)
Dim DigitsBefore As String, DigitsAfter As String
Dim Temp As String
Dim i As Long, j As Long

ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "

'Strip blanks
If VarType(MyNumber) <> vbString Then MyNumber = Str(MyNumber)
If InStr(MyNumber, " ") > 0 Then MyNumber = Replace\$(MyNumber, " ", "")

'Process decimal places first
i = InStr(MyNumber, ".")
If i > 0 Then
If SpellSingleDigitsAfter Then
DigitsAfter = Mid(MyNumber, i + 1)
For j = 1 To Len(DigitsAfter)
Temp = Temp & " " & GetDigit(Mid(DigitsAfter, j, 1), True)
Next
DigitsAfter = Temp
Else
DigitsAfter = " " & GetTens(Left(Mid(MyNumber, i + 1) & "00", 2))
End If
MyNumber = Trim(Left(MyNumber, i - 1))
End If

i = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then DigitsBefore = Temp & Place(i) & DigitsBefore
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
i = i + 1
Loop

If Len(CurrencyBefore) > 0 Then
Select Case DigitsBefore
Case ""
DigitsBefore = "No " & CurrencyBefore & "s"
Case "One"
DigitsBefore = "One " & CurrencyBefore
Case Else
DigitsBefore = DigitsBefore & " " & CurrencyBefore & "s"
End Select
Else
Select Case DigitsBefore
Case ""
DigitsBefore = "Zero"
End Select
End If
If Len(CurrencyAfter) > 0 Then
Select Case DigitsAfter
Case ""
DigitsAfter = " and No " & CurrencyAfter & "s"
Case "One"
DigitsAfter = " and One " & CurrencyAfter
Case Else
DigitsAfter = " and " & DigitsAfter & " " & CurrencyAfter
End Select
ElseIf Len(DotWord) Then
DigitsAfter = " " & DotWord & DigitsAfter
End If

SpellNumber = DigitsBefore & DigitsAfter

'Strip double blanks
Do While InStr(SpellNumber, "  ") > 0
SpellNumber = Replace(SpellNumber, "  ", " ")
Loop
End Function

Function GetHundreds(ByVal MyNumber As String) As String
'Converts a number from 100-999 into text
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

Function GetTens(ByVal TensText As String) As String
'Converts a number from 10 to 99 into text.
Dim Result As String
'If value between 10-19...
If Val(Left(TensText, 1)) = 1 Then
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
'Retrieve ones place.
Result = Result & GetDigit(Right(TensText, 1))
End If
GetTens = Result
End Function

Function GetDigit(ByVal Digit As String, _
Optional ByVal SpellZero As Boolean) As String
'Converts a number from 0 to 9 into text.
Select Case Val(Digit)
Case 0: If SpellZero Then GetDigit = "Zero"
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
```

• Edited by Wednesday, June 24, 2015 12:31 PM
• Proposed as answer by Thursday, June 25, 2015 1:38 AM
• Marked as answer by Wednesday, July 1, 2015 8:25 AM
Wednesday, June 24, 2015 12:31 PM
• VERY COOL!!!

Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

Thursday, June 25, 2015 1:38 AM
• thnx too much , but this vb code only read two digits after Decimcal Places . ( find attach ) .
Thursday, June 25, 2015 9:18 AM

• Note: My Excel is a German edition, that's why the formula and the number in A1 appears different as in your Excel.

• Edited by Thursday, June 25, 2015 10:23 AM Wrong screen shot
Thursday, June 25, 2015 10:22 AM
• thnx too much , now is ok , I miss one step .
Thursday, June 25, 2015 1:27 PM
• I'm pleased to hear that it works.

Would you please so kind and mark the post with the code as answer? So it would be easier to find the right answer for followers. Thank you.

Andreas.
Thursday, June 25, 2015 4:52 PM