Ask Me Help Desk

Ask Me Help Desk (https://www.askmehelpdesk.com/forum.php)
-   Visual Basic (https://www.askmehelpdesk.com/forumdisplay.php?f=469)
-   -   ConvertCurrencytoEnglish - suddenly not working? (https://www.askmehelpdesk.com/showthread.php?t=235727)

  • Jul 9, 2008, 05:39 PM
    DrJ
    ConvertCurrencytoEnglish - suddenly not working?
    OK, so I found this on the web Excel: Convert Currency Number to Words/Text. User Defined/Custom Formula/Function

    It gave me a VB code to use to convert currency into its text representation (like you would write out on a check).

    [btw, I'm a total newbie to VB so bear with me]

    So I added a module and copied the code in (I'll paste the code at the bottom of this post). I then selected the new user defined function and viola, it worked! Then somewhere along the way, it stopped working.

    I went back and started all over again with the VB commands but still can't get it to work. I know I am referencing the right cell and it has a value in it but I am getting the #NAME? Error. Here is what I have

    B18 = $5,000.00
    C18 = =ConvertCurrencyToEnglish(B18)

    The Module code is as this:

    Code:

    Function ConvertCurrencyToEnglish (ByVal MyNumber)
    Dim Temp
            Dim Dollars, Cents
            Dim DecimalPlace, Count

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

            ' Convert MyNumber to a string, trimming extra spaces.
            MyNumber = Trim(Str(MyNumber))

            ' Find decimal place.
            DecimalPlace = InStr(MyNumber, ".")

            ' If we find decimal place...
            If DecimalPlace > 0 Then
                ' Convert cents
                Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
                Cents = ConvertTens(Temp)

                ' Strip off cents from remainder to convert.
                MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
            End If

            Count = 1
            Do While MyNumber <> ""
                ' Convert last 3 digits of MyNumber to English dollars.
                Temp = ConvertHundreds(Right(MyNumber, 3))
                If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
                If Len(MyNumber) > 3 Then
                  ' Remove last 3 converted digits from MyNumber.
                  MyNumber = Left(MyNumber, Len(MyNumber) - 3)
                Else
                  MyNumber = ""
                End If
                Count = Count + 1
            Loop

            ' Clean up dollars.
            Select Case Dollars
                Case ""
                  Dollars = "No Dollars"
                Case "One"
                  Dollars = "One Dollar"
                Case Else
                  Dollars = Dollars & " Dollars"
            End Select

            ' Clean up cents.
            Select Case Cents
                Case ""
                  Cents = " And No Cents"
                Case "One"
                  Cents = " And One Cent"
                Case Else
                  Cents = " And " & Cents & " Cents"
            End Select

            ConvertCurrencyToEnglish = Dollars & Cents
    End Function



    Private Function ConvertHundreds (ByVal MyNumber)
    Dim Result As String

            ' Exit if there is nothing to convert.
            If Val(MyNumber) = 0 Then Exit Function

            ' Append leading zeros to number.
            MyNumber = Right("000" & MyNumber, 3)

            ' Do we have a hundreds place digit to convert?
            If Left(MyNumber, 1) <> "0" Then
                Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
            End If

            ' Do we have a tens place digit to convert?
            If Mid(MyNumber, 2, 1) <> "0" Then
                Result = Result & ConvertTens(Mid(MyNumber, 2))
            Else
                ' If not, then convert the ones place digit.
                Result = Result & ConvertDigit(Mid(MyNumber, 3))
            End If

            ConvertHundreds = Trim(Result)
    End Function



    Private Function ConvertTens (ByVal MyTens)
    Dim Result As String

            ' Is value between 10 and 19?
            If Val(Left(MyTens, 1)) = 1 Then
                Select Case Val(MyTens)
                  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
                ' .. otherwise it's between 20 and 99.
                Select Case Val(Left(MyTens, 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

                ' Convert ones place digit.
                Result = Result & ConvertDigit(Right(MyTens, 1))
            End If

            ConvertTens = Result
    End Function



    Private Function ConvertDigit (ByVal MyDigit)
    Select Case Val(MyDigit)
                Case 1: ConvertDigit = "One"
                Case 2: ConvertDigit = "Two"
                Case 3: ConvertDigit = "Three"
                Case 4: ConvertDigit = "Four"
                Case 5: ConvertDigit = "Five"
                Case 6: ConvertDigit = "Six"
                Case 7: ConvertDigit = "Seven"
                Case 8: ConvertDigit = "Eight"
                Case 9: ConvertDigit = "Nine"
                Case Else: ConvertDigit = ""
            End Select
    End Function

    I have also tried specifying the .xls file when calling the module (EX: ='Loan Mod App.xls'!Module1.ConvertCurrencyToEnglish(B18) --- and even adding the Sheet Name into the equation... regardless, its finding the VB code but no longer doing it properly.


    Any ideas??


    Thanks!

    ~J~
  • Jul 25, 2008, 09:47 AM
    melondotnet
    Got lost! - Make sure that you take of the dollar symbol, else it will try handeling it as an integer, which is always bad. Just to check, does scr(val) convert 'val' into a String? Ages since I used VBA...

    I also believe that your first array writing may be wrong:

    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "

    =

    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(6) = " Billion "
    Place(9) = " Trillion "

    Last thing: When do you actually edit the cell you need to, I can't find it anywhere.

    Range(BLAH,BLAH).FormulaR1C1 = ConvertCurrencyToEnglish

    Hope this was a help.
  • Oct 28, 2008, 02:50 PM
    satswid

    You are having a perfectly working code.
    You are just not calling function

    Just try this

    DIM B18 AS DOUBLE, C18 AS STRING
    B18 = 5,000.00
    C18 = =ConvertCurrencyToEnglish(B18)
    MSGBOX C18


    IT WORKS

  • All times are GMT -7. The time now is 07:51 PM.