-1

This function is supposed to let you convert dollar and cent amounts to words with a formula, so 22.50 would read as Twenty-Two Dollars and Fifty Cents. The formula for this is =SpellNumber(A1)

I seem to be having issues. I got this code straight from Microsoft's website so I do not understand why it would not work. I am quite new to vba and would appreciate some pointers to fix this. Thank you in advance for your help!

     Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

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 amount.

MyNumber = Trim(Str(MyNumber))

' Position of decimal place 0 if none.

DecimalPlace = InStr(MyNumber, ".")

' Convert cents and set MyNumber to dollar amount.

If DecimalPlace > 0 Then
' <-- Edit: remove incorrect line break = underscore character -->
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2))

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 = "No Dollars"

Case "One"

Dollars = "One Dollar"

Case Else

Dollars = Dollars & " Dollars"

End Select

Select Case Cents

Case ""

Cents = " and No Cents"

Case "One"

Cents = " and One Cent"

Case Else

Cents = " and " & Cents & " Cents"

End Select

SpellNumber = Dollars & Cents

End Function


' Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

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)

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
' <-- Edit incorrect line break -->
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)

 Select Case Val(Digit)

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
T.M.
  • 9,436
  • 3
  • 33
  • 57
Mel
  • 15
  • 1
  • 3
  • 1
    Remove the subsequent blank code line immediately after code lines with an underscore at the end (`"_"`) as this marks line breaks; thus an additional line in between cannot be read correctly by VBA. – T.M. Jan 12 '19 at 17:56
  • Related link: [Convert numbers to words with VBA](https://stackoverflow.com/questions/51204004/convert-numbers-to-words-with-vba/51204358#51204358) – T.M. Jan 14 '19 at 09:30

2 Answers2

1

You've reformatted the code improperly. The _ character notes a new code line that continues from the previous without additional line feeds. You've either removed the linefeed or misplaced the _ character altogether.

'This,
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2))

'should have been,
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
'or,
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
   "00", 2))


'This,
Result = Result & GetDigit _

(Right(TensText, 1)) ' Retrieve ones place.

'should have been,
Result = Result & GetDigit(Right(TensText, 1)) ' Retrieve ones place.
'or,
Result = Result & GetDigit _
   (Right(TensText, 1)) ' Retrieve ones place.
1

I wrote new code.

Function NumbertoString(sNum As String)
    Dim s As String
    Dim vDigit(), vR(), vMod()
    Dim Digit1000
    Dim sDal As String, sCent As String
    Dim Cent As String, Num As String
    Dim i As Integer, x As Integer, k As Integer

    If InStr(sNum, ".") Then
        s = Split(sNum, ".")(0)
        Cent = Split(sNum, ".")(1)
    Else
        s = sNum
        Cent = ""
    End If

    Digit1000 = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
    k = Len(s)
    x = k Mod 3
    n = Int(k / 3)
    If n = 0 Then GoTo p
    ReDim vDigit(1 To n)

    '@@If the length of the number is a multiple of 3
    For i = 1 To n
        st = k - i * 3 + 1
        vDigit(i) = Mid(s, st, 3)
    Next i
    '@@If the length of the number is NOT a multiple of 3
p:
    If x > 0 Then
        n = n + 1
        ReDim Preserve vDigit(1 To n)
        vDigit(n) = Left(s, x)
    End If
    For i = n To 1 Step -1
          Num = Num & getString(vDigit(i)) & Digit1000(i)
    Next i
    Select Case Num
        Case ""
            sDal = " No Dallar "
        Case "One"
            sDal = " Dallar "
        Case Else
            sDal = " Dallars "
    End Select

    Select Case getString(Val(Cent))
        Case ""
            sCent = "and No Cents"
        Case "One"
            sCent = " Cent"
        Case Else
            sCent = " Cents"
    End Select
    NumbertoString = Num & sDal & " and " & getString(Val(Cent)) & sCent
End Function

Function getString(s)
    Dim vDigit(), vR(), vMod()
    Dim n As Integer, i As Long
    Dim Num As String

    dig1 = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    dig10 = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
    dig20 = Array("", "", "Twenty ", "Thirty ", "Forty ", "Fitty ", "Sixty ", "Seventy ", "Eighty", "Ninety ")
    If s = "" Then Exit Function
    Do Until (s / 10) < i
        n = n + 1
        i = 10 ^ n
        ReDim Preserve vDigit(1 To n)
        vDigit(n) = i
    Loop
    ReDim vMod(1 To n)
    For i = 1 To n
        vMod(i) = s Mod vDigit(i)
    Next i
    ReDim vR(1 To n + 1)

    vR(1) = vMod(1)
    For i = 2 To n
        vR(i) = Int((vMod(i) - vMod(i - 1)) / vDigit(i - 1))
    Next i
    vR(n + 1) = Int((s - vMod(n)) / vDigit(n))

    Select Case vR(2)
        Case 0
            Num = dig1(vR(1))
        Case 1
            Num = dig10(vR(1))
        Case Else
            Num = dig20(vR(2)) & dig1(vR(1))
    End Select
    If UBound(vR) = 3 Then
        Num = dig1(vR(3)) & " Hundred " & Num
    End If
    getString = Num
End Function

Result image enter image description here

Dy.Lee
  • 7,527
  • 1
  • 12
  • 14
  • Nice solution +1). - Due to **internationalization** I'd suggest to insert the following code line into your main function (after declarations): `sNum = Str(sNum)` in order to force a string actually including a **decimal point**, as for instance central European countries use a comma as number separator. *Minor hint: some missing variable declarations, "Dollars" instead of "Dallars".* – T.M. Jan 14 '19 at 09:23