Results 1 to 10 of 10
  1. #1
    2 Star Lounger
    Join Date
    Sep 2002
    Location
    Birmingham, England
    Posts
    123
    Thanks
    0
    Thanked 0 Times in 0 Posts

    numbers-to-text (xl 97 sr2)

    Anyone got an elegant and efficient way of making xl cause a positive integral number in cell, say a1, provoke the appearance of english words describing that number in cell, say a2?
    Example: 3409 ----------------- THREE THOUSAND FOUR HUNDRED AND NINE
    up to 4 digits only will do for present purpose.
    Have been @#$!% around with a lookup table (and loads of IFs) but not simple and certainly not elegant.
    Thanks

  2. #2
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: numbers-to-text (xl 97 sr2)

    Here is a function to have a number change to text if A1 "100", in B1 you could enter "=NumbertoWords(a1)" and B1 would display "One Hundred". It does not affect the number.

    I also have a subroutine which will convert ALL the numbers in a selected range of cells to the text. This will "destroy" the values in the cells. If desired, copy the range to a place before replacing or change to code to copy the text one column over.
    it is valid for Integers from 0 to 999,999.

    There are also several subroutines that the 2 programs call. I got these from Allen Wyatt's Excel Tips, though I have seen variations at many places.

    Hope it comes in handy,
    Steve
    <pre>Function NumberToWords(rngSrc As Range)
    Dim lMax As Long
    Dim bNCFlag As Boolean
    Dim lNumber As Long, sWords As String

    bNCFlag = False
    vCVal = rngSrc.Value
    NumberToWords = ""
    If IsNumeric(vCVal) Then
    If vCVal <> CLng(vCVal) Then
    bNCFlag = True
    Else
    lNumber = CLng(vCVal)
    Select Case lNumber
    Case 0
    NumberToWords = "Zero"
    Case 1 To 999999
    NumberToWords = SetThousands(lNumber)
    Case Else
    bNCFlag = True
    End Select
    End If
    Else
    bNCFlag = True
    End If
    If NumberToWords = "" Then
    NumberToWords = CVErr(xlErrNull)
    End If

    If bNCFlag Then
    NumberToWords = CVErr(xlErrNA)
    End If
    End Function


    Sub RangeNumberToWords()
    Dim rngSrc As Range
    Dim lMax As Long
    Dim bNCFlag As Boolean
    Dim sTitle As String, sMsg As String
    Dim vCVal As Variant
    Dim lNumber As Long, sWords As String

    Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)
    lMax = rngSrc.Cells.Count

    bNCFlag = False
    For lCtr = 1 To lMax
    vCVal = rngSrc.Cells(lCtr).Value
    sWords = ""
    If IsNumeric(vCVal) Then
    If vCVal <> CLng(vCVal) Then
    bNCFlag = True
    Else
    lNumber = CLng(vCVal)
    Select Case lNumber
    Case 0
    sWords = "Zero"
    Case 1 To 999999
    sWords = SetThousands(lNumber)
    Case Else
    bNCFlag = True
    End Select
    End If
    Else
    bNCFlag = True
    End If
    If sWords > "" Then
    rngSrc.Cells(lCtr) = sWords
    End If
    Next lCtr

    If bNCFlag Then
    sTitle = "lNumberToWords Macro"
    sMsg = "Not all cells converted. May not be whole number or maybe too large."
    MsgBox sMsg, vbExclamation, sTitle
    End If
    End Sub


    Private Function SetOnes(ByVal lNumber As Integer) As String
    Dim OnesArray(9) As String
    OnesArray(1) = "One"
    OnesArray(2) = "Two"
    OnesArray(3) = "Three"
    OnesArray(4) = "Four"
    OnesArray(5) = "Five"
    OnesArray(6) = "Six"
    OnesArray(7) = "Seven"
    OnesArray(8) = "Eight"
    OnesArray(9) = "Nine"
    SetOnes = OnesArray(lNumber)
    End Function


    Private Function SetTens(ByVal lNumber As Integer) As String
    Dim TensArray(9) As String
    TensArray(1) = "Ten"
    TensArray(2) = "Twenty"
    TensArray(3) = "Thirty"
    TensArray(4) = "Fourty"
    TensArray(5) = "Fifty"
    TensArray(6) = "Sixty"
    TensArray(7) = "Seventy"
    TensArray(8) = "Eighty"
    TensArray(9) = "Ninety"
    Dim TeensArray(9) As String
    TeensArray(1) = "Eleven"
    TeensArray(2) = "Twelve"
    TeensArray(3) = "Thirteen"
    TeensArray(4) = "Fourteen"
    TeensArray(5) = "Fifteen"
    TeensArray(6) = "Sixteen"
    TeensArray(7) = "Seventeen"
    TeensArray(8) = "Eighteen"
    TeensArray(9) = "Nineteen"
    Dim iTemp1 As Integer
    Dim iTemp2 As Integer
    Dim sTemp As String
    iTemp1 = Int(lNumber / 10)
    iTemp2 = lNumber Mod 10
    sTemp = TensArray(iTemp1)
    If (iTemp1 = 1 And iTemp2 > 0) Then
    sTemp = TeensArray(iTemp2)
    Else
    If (iTemp1 > 1 And iTemp2 > 0) Then
    sTemp = sTemp + " " + SetOnes(iTemp2)
    End If
    End If
    SetTens = sTemp
    End Function


    Private Function SetHundreds(ByVal lNumber As Integer) As String
    Dim iTemp1 As Integer
    Dim iTemp2 As Integer
    Dim sTemp As String
    iTemp1 = Int(lNumber / 100)
    iTemp2 = lNumber Mod 100
    If iTemp1 > 0 Then sTemp = SetOnes(iTemp1) + " Hundred"
    If iTemp2 > 0 Then
    If sTemp > "" Then sTemp = sTemp + " "
    If iTemp2 < 10 Then sTemp = sTemp + SetOnes(iTemp2)
    If iTemp2 > 9 Then sTemp = sTemp + SetTens(iTemp2)
    End If
    SetHundreds = sTemp
    End Function


    Private Function SetThousands(ByVal lNumber As Long) As String
    Dim iTemp1 As Integer
    Dim iTemp2 As Integer
    Dim sTemp As String
    iTemp1 = Int(lNumber / 1000)
    iTemp2 = lNumber Mod 1000
    If iTemp1 > 0 Then sTemp = SetHundreds(iTemp1) + " Thousand"
    If iTemp2 > 0 Then
    If sTemp > "" Then sTemp = sTemp + " "
    sTemp = sTemp + SetHundreds(iTemp2)
    End If
    SetThousands = sTemp
    End Function
    </pre>


  3. #3
    2 Star Lounger
    Join Date
    Sep 2002
    Location
    Birmingham, England
    Posts
    123
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: numbers-to-text (xl 97 sr2)

    Thanks v much, something for me to work on!
    But first, maybe, to buy a bigger hard disc <grin>.

  4. #4
    3 Star Lounger
    Join Date
    Jan 2002
    Location
    The Hague, Netherlands
    Posts
    283
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: numbers-to-text (xl 97 sr2)

    NUMTEXT

    which is part of MOREFUNC.XLL (a fast add-in, downloadable from: http://longre.free.fr/english/index.html)

    will do what you want.
    Microsoft MVP - Excel

  5. #5
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: numbers-to-text (xl 97 sr2)

    Here is what I use, it works for up to Sextllions. It will also give you something like Three Hundred Thirty Dollars and Sixty Seven Cents if you pass it the optional second and third parameters. like this:

    <pre>=NumberToText(330.67,"Dollars","Cents")
    </pre>




    <pre>Function NumberToText(Num As Variant, Optional vCurName As Variant, Optional vCent As Variant) As Variant
    Dim TMBT As Variant
    Dim sNum As String, sDec As String, sHun As String, IC As Integer
    Dim Result As String, sCurName As String, sCent As String


    If Application.IsNumber(Num) = False Then
    NumberToText = CVErr(xlValue)
    Exit Function
    End If

    If IsMissing(vCurName) Then
    sCurName = ""
    Else
    sCurName = Trim(CStr(vCurName))
    End If
    If IsMissing(vCent) Then
    sCent = ""
    Else
    sCent = Trim(CStr(vCent))
    End If


    TMBT = Array("", "Thousand", "Million", "Billion", "Trillion", "Quadrillion", "Quintillion", "Sextillion")

    If IsMissing(sCent) Or IsNull(sCent) Then
    sNum = Format(Application.Round(Num, 0), "0")
    Else
    sNum = Format(Application.Round(Num, 2), "0.00")
    sDec = Right(sNum, 2)
    sNum = Left(sNum, Len(sNum) - 3)
    If CInt(sDec) <> 0 Then
    sDec = "and " & Trim(HundredsToText(CVar(sDec)) & " " & sCent)
    Else
    sDec = ""
    End If
    End If

    IC = 0
    While Len(sNum) > 0
    sHun = Right(sNum, 3)
    sNum = Left(sNum, Application.Max(Len(sNum) - 3, 0))
    If CInt(sHun) <> 0 Then
    Result = Trim(Trim(HundredsToText(CVar(sHun)) & " " & TMBT(IC)) & " " & Result)
    End If
    IC = IC + 1
    Wend
    Result = Trim(Result & " " & sCurName)
    Result = Trim(Result & " " & sDec)

    NumberToText = Result

    End Function

    Function HundredsToText(Num As Integer) As String
    Dim Units As Variant, Teens As Variant, Tens As Variant
    Dim I As Integer, IUnit As Integer, ITen As Integer, IHundred As Integer
    Dim Result As String

    Units = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
    Teens = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", _
    "Eighteen", "Nineteen")
    Tens = Array("", "", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")

    Result = ""
    IUnit = Num Mod 10
    I = Int(Num / 10)
    ITen = I Mod 10
    IHundred = Int(I / 10)
    If IHundred > 0 Then
    Result = Units(IHundred) & " Hundred"
    End If
    If ITen = 1 Then
    Result = Result & " " & Teens(IUnit)
    Else
    If ITen > 1 Then
    Result = Trim(Result & " " & Tens(ITen) & " " & Units(IUnit))
    Else
    Result = Trim(Result & " " & Units(IUnit))
    End If
    End If

    HundredsToText = Result

    End Function
    </pre>


    Wide code split- Mod (GW)
    Legare Coleman

  6. #6
    2 Star Lounger
    Join Date
    Sep 2002
    Location
    Birmingham, England
    Posts
    123
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: numbers-to-text (xl 97 sr2)

    Thanks v much, all 3. Have run with the MOREFUNC method, which works a treat.
    But if and only if the machine reading the file with the =numtext function in it is fitted up with the add-in.
    Daft question - is there any way of 'embedding' the function in the file, like a typeface can be embedded in a Word doc?
    I suspect 'no' but the world is full of surprises, some of them nice.

  7. #7
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

    Re: numbers-to-text (xl 97 sr2)

    Go to VB and add the function commands in a module.
    It will be available in that file since it is saved with the file.

    Steve

  8. #8
    2 Star Lounger
    Join Date
    Sep 2002
    Location
    Birmingham, England
    Posts
    123
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: numbers-to-text (xl 97 sr2)

    Ok, Steve, so it's possible.
    But to me the only 'function command' I know is to type
    =numtext(cellref) into a cell (actually, = if(cellref="","",numtext(cellref)) and set up the numtext bit to show 2 dec places and include the word 'pound') which it plurals for me.
    I know where the VIsual Basic editor lives, but beyond that, almost zilch.
    How do I extract the code from the function?
    Thanks!
    John

  9. #9
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: numbers-to-text (xl 97 sr2)

    Since you use the MoreFunc.XLL which is a addin, the VBA code may not be available to you. If it is, it would be in the file that you downloaded to get the addin.

    My post and at least one other contains the VBA code that would need to be copied and pasted into a VBA module in your workbook.
    Legare Coleman

  10. #10
    3 Star Lounger
    Join Date
    Jan 2002
    Location
    The Hague, Netherlands
    Posts
    283
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: numbers-to-text (xl 97 sr2)

    The answer is indeed "No." You have no access to the underlying code. This add-in is not written in VBA but in C (or C++). That is why the functions it includes are as fast as the built-in functions.
    Microsoft MVP - Excel

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •