Convert Numbers to Words

N = Array(“”, “One”, “Two”, “Three”, “Four”, “Five”, “Six”, “Seven”, “Eight”, “Nine”, “Ten”, “Eleven”, “Twelve”, “Thirteen”, “Fourteen”, “Fifteen”, “Sixteen”, “Seventeen”, “Eighteen”, “Nineteen”)T = Array(“”, “”, “Twenty”, “Thirty”, “Forty”, “Fifty”, “Sixty”, “Seventy”, “Eighty”, “Ninety”)
Dim A, B, H, L, NewAmount, P, WORD, Z
L = Len(Amount)
P = InStr(1, Amount, “.”) ‘Is there is a decimal point
If P = 0 Then Amount = Amount + “.00”
If L – P = 1 Then Amount = Amount + “0” ‘ ONLY ONE number after the point so add a zero
L = Len(Amount) ‘ Reset L in case the Amount has changed
If L > 8 Then
response = MsgBox(“The amount is too large please break the figure into two cheques”, vbCritical)
Exit Sub
End If
‘CALCULATE THOUSANDS
If L > 6 Then ‘There are thousands
Z = L – 3 ‘ Z holds the number of thousand digits
‘CALCULATE THOUSANDS
thousands = Left(Amount, Z – 3)
If thousands > 19 Then
A = Left(thousands, 1)
B = Right(thousands, 1)
WORD = T(A) + N(B) + ” Thousand ”
Else
WORD = N(thousands) + ” Thousand ”
End If
End If
‘CALCULATE HUNDREDS
If L > 5 Then
NewAmount = Right(Amount, 6)
A = Left(NewAmount, 1)
WORD = WORD + N(A) + ” Hundred and ”
End If
‘CALCULATE TENS
If L > 4 Then ‘ There are tens and units
NewAmount = Right(Amount, 5)
If Left(NewAmount, 2) > 19 Then
WORD = WORD + T(Left(NewAmount, 1))
WORD = WORD + N(Mid(NewAmount, 2, 1))
Else
WORD = WORD + N(Left(NewAmount, 2))
End If
End If
If L = 4 Then
WORD = WORD + N(Left(NewAmount, 1))
End If
WORD = WORD + ” pounds”
‘NOW CALULATE PENCE
pence = Right(Amount, 2)
WORD = WORD + ” and ” + pence + ” pence”
Cells(4, 3) = Amount
WORD = Replace(WORD, “and 00 pence”, “only”)
Cells(2, 3) = WORD

Leave a Reply