Number convert into text in excel by coading

 Function SpellNumber(amt As Variant) As Variant

Dim FIGURE As Variant

Dim LENFIG As Integer

Dim i As Integer

Dim WORDs(19) As String

Dim tens(9) As String

WORDs(1) = "One"

WORDs(2) = "Two"

WORDs(3) = "Three"

WORDs(4) = "Four"

WORDs(5) = "Five"

WORDs(6) = "Six"

WORDs(7) = "Seven"

WORDs(8) = "Eight"

WORDs(9) = "Nine"

WORDs(10) = "Ten"

WORDs(11) = "Eleven"

WORDs(12) = "Twelve"

WORDs(13) = "Thirteen"

WORDs(14) = "Fourteen"

WORDs(15) = "Fifteen"

WORDs(16) = "Sixteen"

WORDs(17) = "Seventeen"

WORDs(18) = "Eighteen"

WORDs(19) = "Nineteen"

tens(2) = "Twenty"

tens(3) = "Thirty"

tens(4) = "Fourty"

tens(5) = "Fifty"

tens(6) = "Sixty"

tens(7) = "Seventy"

tens(8) = "Eighty"

tens(9) = "Ninety"

FIGURE = amt

FIGURE = Format(FIGURE, "FIXED")

FIGLEN = Len(FIGURE)

If FIGLEN < 12 Then

FIGURE = Space(12 - FIGLEN) & FIGURE

End If

If Val(Left(FIGURE, 9)) > 1 Then

SpellNumber = "Rupees "

ElseIf Val(Left(FIGURE, 9)) = 1 Then

SpellNumber = "Rupee "

End If

For i = 1 To 3

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

If i = 1 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Crore "

ElseIf i = 2 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Lakh "

ElseIf i = 3 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & " Thousand "

End If

FIGURE = Mid(FIGURE, 3)

Next i

If Val(Left(FIGURE, 1)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 1))) + " Hundred "

End If

FIGURE = Mid(FIGURE, 2)

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

FIGURE = Mid(FIGURE, 4)

If Val(FIGURE) > 0 Then

SpellNumber = SpellNumber & " Paise "

If Val(Left(FIGURE, 2)) < 20 And Val(Left(FIGURE, 2)) > 0 Then

SpellNumber = SpellNumber & WORDs(Val(Left(FIGURE, 2)))

ElseIf Val(Left(FIGURE, 2)) > 19 Then

SpellNumber = SpellNumber & tens(Val(Left(FIGURE, 1)))

SpellNumber = SpellNumber & WORDs(Val(Right(Left(FIGURE, 2), 1)))

End If

End If

FIGURE = amt

FIGURE = Format(FIGURE, "FIXED")

If Val(FIGURE) > 0 Then

SpellNumber = SpellNumber & " Only "

End If

End Function

Number conbert to spelling iin excel vba

 Function NumToWord(ByVal N As Currency) As String

   Const Ten = 10@

   Const Hundred = Ten * Ten

   Const Thousand = Ten * Hundred

   Const Lakh = Thousand * Hundred

   Const Crore = Lakh * Hundred

   Const Million = Thousand * Thousand

   Const Billion = Thousand * Million

   Const Trillion = Thousand * Billion

   If (N = 0@) Then NumToWord = "zero": Exit Function

   Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = ""

   Dim Frac As Currency: Frac = Abs(N - Fix(N))

   If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N))

   Dim AtLeastOne As Integer: AtLeastOne = N >= 1

   If (N >= Crore) Then

      Buf = Buf & NumToWordDigitGroup(Int(N / Crore)) & " Crore"

      N = N - Int(N / Crore) * Crore

      If (N >= 1@) Then Buf = Buf & " "

   End If

   If (N >= Lakh) Then

      Buf = Buf & NumToWordDigitGroup(Int(N / Lakh)) & " Lakh"

      N = N - Int(N / Lakh) * Lakh

      If (N >= 1@) Then Buf = Buf & " "

   End If

   If (N >= Thousand) Then

      Buf = Buf & NumToWordDigitGroup(N \ Thousand) & " Thousand"

      N = N Mod Thousand

      If (N >= 1@) Then Buf = Buf & " "

   End If

   If (N >= Hundred) Then

      Buf = Buf & NumToWordDigitGroup(N \ Hundred) & " hundred"

      N = N Mod Hundred

      If (N >= 1@) Then Buf = Buf & " "

   End If

   If (N >= 1@) Then

      Buf = Buf & NumToWordDigitGroup(N)

   End If

   NumToWord = Buf

End Function

Private Function NumToWordDigitGroup(ByVal N As Integer) As String

   Const Hundred = " hundred"

   Const One = "one"

   Const Two = "two"

   Const Three = "three"

   Const Four = "four"

   Const Five = "five"

   Const Six = "six"

   Const Seven = "seven"

   Const Eight = "eight"

   Const Nine = "nine"

   Dim Buf As String: Buf = ""

   Dim Flag As Integer: Flag = False

   Select Case (N \ 100)

      Case 0: Buf = "": Flag = False

      Case 1: Buf = One & Hundred: Flag = True

      Case 2: Buf = Two & Hundred: Flag = True

      Case 3: Buf = Three & Hundred: Flag = True

      Case 4: Buf = Four & Hundred: Flag = True

      Case 5: Buf = Five & Hundred: Flag = True

      Case 6: Buf = Six & Hundred: Flag = True

      Case 7: Buf = Seven & Hundred: Flag = True

      Case 8: Buf = Eight & Hundred: Flag = True

      Case 9: Buf = Nine & Hundred: Flag = True

   End Select

   If (Flag <> False) Then N = N Mod 100

   If (N > 0) Then

      If (Flag <> False) Then Buf = Buf & " "

   Else

      NumToWordDigitGroup = Buf

      Exit Function

   End If

   Select Case (N \ 10)

      Case 0, 1: Flag = False

      Case 2: Buf = Buf & "twenty": Flag = True

      Case 3: Buf = Buf & "thirty": Flag = True

      Case 4: Buf = Buf & "forty": Flag = True

      Case 5: Buf = Buf & "fifty": Flag = True

      Case 6: Buf = Buf & "sixty": Flag = True

      Case 7: Buf = Buf & "seventy": Flag = True

      Case 8: Buf = Buf & "eighty": Flag = True

      Case 9: Buf = Buf & "ninety": Flag = True

   End Select

   If (Flag <> False) Then N = N Mod 10

   If (N > 0) Then

      If (Flag <> False) Then Buf = Buf & "-"

   Else

      NumToWordDigitGroup = Buf

      Exit Function

   End If

   Select Case (N)

      Case 0:

      Case 1: Buf = Buf & One

      Case 2: Buf = Buf & Two

      Case 3: Buf = Buf & Three

      Case 4: Buf = Buf & Four

      Case 5: Buf = Buf & Five

      Case 6: Buf = Buf & Six

      Case 7: Buf = Buf & Seven

      Case 8: Buf = Buf & Eight

      Case 9: Buf = Buf & Nine

      Case 10: Buf = Buf & "ten"

      Case 11: Buf = Buf & "eleven"

      Case 12: Buf = Buf & "twelve"

      Case 13: Buf = Buf & "thirteen"

      Case 14: Buf = Buf & "fourteen"

      Case 15: Buf = Buf & "fifteen"

      Case 16: Buf = Buf & "sixteen"

      Case 17: Buf = Buf & "seventeen"

      Case 18: Buf = Buf & "eighteen"

      Case 19: Buf = Buf & "nineteen"

   End Select

   NumToWordDigitGroup = Buf

    End Function

All excel sheet convertinto excel files

 Sub SplitEachWorksheet()

Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
    ws.Copy
    Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Automatic bill save any location serieal wise

 Sub SaveInvoiceWithNewName()

    Dim NewFN As Variant

    ' Copy Invoice to a New Workbook

    ActiveSheet.Copy

    NewFN = "C:\\" & Range("i5").Value & ".xlsx"

    ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook

    ActiveWorkbook.Close

    NextInvoice

End Sub

Sub NextInvoice()

Range("i5").Value = Range("i5").Value + 1

Range("c5:g5").ClearContents

Range("b10:b20").ClearContents

Range("e10:e20").ClearContents

End Sub

Auto highlight column and row by vba cod in excel

 'Deepak EduWorld...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Application.ScreenUpdating = False
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.FindFormat.Interior.Color = 65534
  Application.ReplaceFormat.Interior.Color = xlNone
  Cells.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.FindFormat.Interior.Color = xlNone
  Application.ReplaceFormat.Interior.Color = 65534
  Target.EntireRow.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Target.EntireColumn.Replace "", "", SearchFormat:=True, ReplaceFormat:=True
  Application.FindFormat.Clear
  Application.ReplaceFormat.Clear
  Application.ScreenUpdating = True
End Sub 'Deepak EduWorld...