VBA : Convert Numbers into words

Convert Numbers into words

Function Inwords(ByVal Nvalue As Double)

On error goto lb1

Dim intDecimal As String
Dim intTens As String
Dim inthundred As String
Dim intthousand As String
Dim intLakh As String
Dim intcrore As String

Dim strValue As String

strValue = Format(Nvalue, "#0.00")
intDecimal = Right(strValue, 2)


'******* Converting Crore place into words **************


If Nvalue >= 10000000 Then

If Len(strValue) >= 12 Then

intcrore = Left(Right(strValue, 12), 2)

ElseIf Len(strValue) >= 11 Then

intcrore = Left(Right(strValue, 11), 1)

End If

If CInt(intcrore) > 19 Then

intcrore = completetens(Left(intcrore, 1) * 10) & " " & Tens(Right(intcrore, 1)) & " Crore "

ElseIf CInt(intcrore) <> 0 Then

intcrore = Tens(intcrore) & " Crore "

Else

intcrore = ""

End If

End If



'******* Converting Lakh place into words **************


If Nvalue >= 100000 Then

If Len(strValue) >= 10 Then

intLakh = Left(Right(strValue, 10), 2)

ElseIf Len(strValue) >= 9 Then

intLakh = Left(Right(strValue, 9), 1)

End If

If CInt(intLakh) > 19 Then

intLakh = completetens(Left(intLakh, 1) * 10) & " " & Tens(Right(intLakh, 1)) & " Lac "

ElseIf CInt(intLakh) <> 0 Then

intLakh = Tens(intLakh) & " Lac "

Else

intLakh = ""

End If

End If


'******* Converting Thousand place into words **************

If Nvalue >= 1000 Then

If Len(strValue) >= 8 Then

intthousand = Left(Right(strValue, 8), 2)

ElseIf Len(strValue) >= 7 Then

intthousand = Left(Right(strValue, 7), 1)

End If

If CInt(intthousand) > 19 Then

intthousand = completetens(Left(intthousand, 1) * 10) & " " & Tens(Right(intthousand, 1)) & " Thousand "

ElseIf CInt(intthousand) <> 0 Then

intthousand = Tens(intthousand) & " Thousand "

Else

intthousand = ""

End If

End If


'******* Converting Hundred place into words **************

If Nvalue >= 100 Then

If CInt(Left(Right(strValue, 6), 1)) <> 0 Then inthundred = Tens(Left(Right(strValue, 6), 1)) & " Hundred "

Else
inthundred = ""

End If


'******* Converting Ones and Tens places into words **************

intTens = Left(Right(strValue, 5), 2)
If Nvalue >= 1 And CInt(intTens) <> 0 Then



If CInt(intTens) > 19 Then

intTens = completetens(Left(intTens, 1) * 10) & " " & Tens(Right(intTens, 1)) & " "
Else
intTens = Tens(intTens) & " "

End If

Else
intTens = ""

End If



'******* Converting Decimals places into words **************

If CInt(intDecimal) <> 0 Then

If CInt(intDecimal) > 19 Then

intDecimal = completetens(Left(intDecimal, 1) * 10) & " " & Tens(Right(intDecimal, 1)) & " Paise "
Else
intDecimal = Tens(intDecimal) & " Paise "

End If
Else
intDecimal = ""

End If



If intDecimal <> "" Then

mystring = intcrore & intLakh & intthousand & inthundred & intTens & "and " & intDecimal & "Only"
Else
mystring = intcrore & intLakh & intthousand & inthundred & intTens & "Only"
End If
inwords = Trim(mystring)

exit function
lb1:
inwords =""

End Function



Function Tens(IntValue)

Select Case IntValue

Case 1
Tens = "One"
Case 2
Tens = "Two"
Case 3
Tens = "Three"
Case 4
Tens = "Four"
Case 5
Tens = "Five"
Case 6
Tens = "Six"
Case 7
Tens = "Seven"
Case 8
Tens = "Eight"
Case 9
Tens = "Nine"
Case 10
Tens = "Ten"
Case 11
Tens = "Eleven"
Case 12
Tens = "Twelve"
Case 13
Tens = "Thirteen"
Case 14
Tens = "Fourteen"
Case 15
Tens = "Fifteen"
Case 16
Tens = "Sixteen"
Case 17
Tens = "Seventeen"
Case 18
Tens = "Eighteen"
Case 19
Tens = "Nineteen"
End Select

End Function

Function completetens(IntValue)

Select Case IntValue
Case 20
completetens = "Twenty"
Case 30
completetens = "Thirty"
Case 40
completetens = "Fourty"
Case 50
completetens = "Fifty"
Case 60
completetens = "Sixty"
Case 70
completetens = "Seventy"
Case 80
completetens = "Eighty"
Case 90
completetens = "Ninety"
End Select

End Function