NumberToWords.vb

Sub sumit()

      
    Dim mainWorkBook
    
    Set mainWorkBook = ActiveWorkbook
    
    
    intRows = mainWorkBook.Sheets("Main").UsedRange.Rows.Count
    'MsgBox intRows
    For i = 1 To intRows
    intValue = mainWorkBook.Sheets("Main").Range("A" & i)
       If intValue <> "" Then
            mainWorkBook.Sheets("Main").Range("B" & i) = FnConvert(intValue)
       End If
    Next

   

End Sub
Function FnConvert(strNumber)

    blnDecimalExist = False
    strNumber = CStr(strNumber)
    
    If InStr(1, strNumber, ".", vbTextCompare) > 0 Then
        arrSplit = Split(strNumber, ".")
        strNumber = arrSplit(0)
        strDecimal = arrSplit(1)
        
        If Len(strDecimal) > 2 Then
            strDecimal = Mid(strDecimal, 0, 2)
        End If
         
        If Len(strDecimal) > 0 And Len(strDecimal) < 2 Then
            strDecimalConversion = FnGetUnitDigit(strDecimal)
        End If
        If Len(strDecimal) > 1 And Len(strDecimal) < 3 Then
            strDecimalConversion = FnGetTensDigit(strDecimal)
        End If
        
        blnDecimalExist = True
        
    End If
    
    If Len(strNumber) > 0 And Len(strNumber) < 2 Then
        strTextConversion = FnGetUnitDigit(strNumber)
    End If
    If Len(strNumber) > 1 And Len(strNumber) < 3 Then
        strTextConversion = FnGetTensDigit(strNumber)
    End If
    If Len(strNumber) > 2 And Len(strNumber) < 4 Then
        strTextConversion = FnGetHundreds(strNumber)
    End If
    If Len(strNumber) > 3 And Len(strNumber) < 6 Then
        If Len(strNumber) = 4 Then
            strTextConversion = FnGetThousandsOne(strNumber)
        End If
        If Len(strNumber) = 5 Then
            strTextConversion = FnGetThousandsTwo(strNumber)
        End If
    End If
     If Len(strNumber) > 5 And Len(strNumber) < 8 Then
       If Len(strNumber) = 6 Then
            strTextConversion = FnGetLacsOne(strNumber)
        End If
        If Len(strNumber) = 7 Then
            strTextConversion = FnGetLacsTwo(strNumber)
        End If
    End If
    If Len(strNumber) > 7 And Len(strNumber) < 15 Then
       If Len(strNumber) = 8 Then
            strTextConversion = FnGetCroreOne(strNumber)
        End If
        If Len(strNumber) = 9 Then
            strTextConversion = FnGetCroreTwo(strNumber)
        End If
        If Len(strNumber) = 10 Then
            strTextConversion = FnGetCroreThree(strNumber)
        End If
        If Len(strNumber) = 11 Then
            strTextConversion = FnGetCroreFour(strNumber)
        End If
        If Len(strNumber) = 12 Then
            strTextConversion = FnGetCroreFive(strNumber)
        End If
        If Len(strNumber) = 13 Then
            strTextConversion = FnGetCroreSix(strNumber)
        End If
        If Len(strNumber) = 14 Then
            strTextConversion = FnGetCroreSeven(strNumber)
        End If
    End If
    
    
    If blnDecimalExist Then
        strTextConversion = "Rupees " & strTextConversion & " and " & strDecimalConversion & " paise only"
    Else
        strTextConversion = "Rupees " & strTextConversion
    End If
    FnConvert = strTextConversion
End Function
Function FnGetCroreSeven(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetLacsTwo(Left(intN, 7)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 7))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreSeven = Str
End Function

Function FnGetCroreSix(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetLacsOne(Left(intN, 6)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 6))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreSix = Str
End Function

Function FnGetCroreFive(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetThousandsTwo(Left(intN, 5)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 5))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreFive = Str
End Function

Function FnGetCroreFour(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetThousandsOne(Left(intN, 4)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 4))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreFour = Str
End Function

Function FnGetCroreThree(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetHundreds(Left(intN, 3)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreThree = Str
End Function

Function FnGetCroreTwo(intN)
    Dim Str
    
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetLacsTwo(Right(intN, Len(intN) - 2))
    End If
    
    FnGetCroreTwo = Str
End Function

Function FnGetCroreOne(intN)
    Dim Str
     
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Crore " & FnGetLacsTwo(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetLacsTwo(Right(intN, Len(intN) - 1))
    End If
    
     FnGetCroreOne = Str
End Function
Function FnGetLacsTwo(intN)
    Dim Str
    
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Lacs " & FnGetThousandsTwo(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetThousandsTwo(Right(intN, Len(intN) - 2))
    End If
    
    FnGetLacsTwo = Str
End Function
Function FnGetLacsOne(intN)
    Dim Str
     'Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1))
     
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetThousandsTwo(Right(intN, Len(intN) - 1))
    End If
    
    
     FnGetLacsOne = Str
End Function
Function FnGetThousandsTwo(intN)
    Dim Str
    'Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2))
    
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetHundreds(Right(intN, Len(intN) - 2))
    End If
    
    
    FnGetThousandsTwo = Str
End Function
Function FnGetThousandsOne(intN)
    Dim Str
    'Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1))
    
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetHundreds(Right(intN, Len(intN) - 1))
    End If
    
    FnGetThousandsOne = Str
End Function
Function FnGetHundreds(intN)
    Dim Str
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Hundred " & FnGetTensDigit(Right(intN, 2))
    Else
        Str = FnGetTensDigit(Right(intN, 2))
    End If
    
    FnGetHundreds = Trim(Str)
End Function
Function FnGetTensDigit(intN)
    Dim Str
    If Left(intN, 1) = 1 Then
       Select Case Val(intN)
            Case 10: Str = "Ten"
            Case 11: Str = "Eleven"
            Case 12: Str = "Twelve"
            Case 13: Str = "Thirteen"
            Case 14: Str = "Fourteen"
            Case 15: Str = "Fifteen"
            Case 16: Str = "Sixteen"
            Case 17: Str = "Seventeen"
            Case 18: Str = "Eighteen"
            Case 19: Str = "Nineteen"
        End Select
    Else
        Select Case Val(Left(intN, 1))
            Case 2: Str = "Twenty"
            Case 3: Str = "Thirty"
            Case 4: Str = "Fourty"
            Case 5: Str = "Fifty"
            Case 6: Str = "Sixty"
            Case 7: Str = "Seventy"
            Case 8: Str = "Eighty"
            Case 9: Str = "Ninty"
        End Select
        
        Str = Str & " " & FnGetUnitDigit(Right(intN, 1))
    End If
    
    FnGetTensDigit = Trim(Str)
End Function
Function FnGetUnitDigit(intN)

    Dim Str

    Select Case Val(intN)
        Case 1: Str = "One"
        Case 2: Str = "Two"
        Case 3: Str = "Three"
        Case 4: Str = "Four"
        Case 5: Str = "Five"
        Case 6: Str = "Six"
        Case 7: Str = "Seven"
        Case 8: Str = "Eight"
        Case 9: Str = "Nine"
    End Select
        FnGetUnitDigit = Trim(Str)
End Function