Question : SpellNumber

Why when I ''SpellNumber(A1)'' does it insert "AND" before numbers larger than 10,000,000? Is it because the cells it is converting are currency format?? And why, if there are pence involved does it insert "and" in lower case? Help! Thanks

Answer : SpellNumber

Again all code is included and there are two fixes,
blank returns blank
1 returns one pund i.e. singular

Chris
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:



Function spellnumber(numberRange As Range)
    If numberRange = "" Then
        spellnumber = ""
    Else
        spellnumber = Currency2Words(numberRange, "Pounds", "Pence")
    End If
End Function

Function Currency2Words(ByVal MyNumber, Optional strUnits, Optional strFrac)
Dim Temp
Dim Units
Dim Frac
Dim DecimalPlace
Dim Count

    If IsMissing(strUnits) Then strUnits = "Dollars"
    If IsMissing(strFrac) Then strFrac = "Cents"
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "

         
    MyNumber = Trim(str(MyNumber))
    DecimalPlace = InStr(MyNumber, ".")
    If DecimalPlace > 0 Then
        Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
        Frac = ConvertTens(Temp)
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If

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

    Units = Trim(Units) & " "
    Select Case Trim(Units)
       Case ""
          Units = "" '"No " & strUnits
       Case "One"
          Units = "One " & Left(strUnits, Len(strUnits) - 1)
       Case Else
          Units = Units & strUnits
    End Select
    Select Case Trim(Frac)
       Case ""
          Frac = "" '" And No " & strFrac
       Case "One"
          If Units = "" Then
            Frac = Frac & " " & strFrac
          Else
            Frac = " And One " & Left(strFrac, Len(strFrac) - 1)
        End If
       Case Else
          If Units = "" Then
            Frac = Frac & " " & strFrac
          Else
            Frac = " and " & Frac & " " & strFrac
          End If
    End Select

    If Units = "" Then
        Currency2Words = Frac
    Else
        Currency2Words = Units & Frac
    End If
    Currency2Words = Replace(Trim(Currency2Words), "  ", " ")
End Function

Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String

    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)

    ' Hundreds
    If Left(MyNumber, 1) <> "0" Then
       Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
    End If

    ' tens
    If Mid(MyNumber, 2, 1) <> "0" Then
       Result = Result & ConvertTens(Mid(MyNumber, 2))
    Else
       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