numbers-to-text (xl 97 sr2)

Topic

New Reply

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

Reply | Quote

Replies

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

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

Reply | Quote

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

Reply | Quote

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.

Reply | Quote

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.

Reply | Quote

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

Reply | Quote

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

Reply | Quote

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.

Reply | Quote

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.

Reply | Quote

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:

=NumberToText(330.67,"Dollars","Cents")

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

Wide code split- Mod (GW)

Reply | Quote