Sub ConvertNumberIntoNumberName()

'Define the workbook
Dim WKB As Workbook
Set WKB = ActiveWorkbook

'Define the worksheet
Dim SH As Worksheet
Set SH = WKB.Sheets("Sheet2")
SH.Activate

'Remove the existing Data except first column
SH.Range(Cells(1, 2), Cells(SH.UsedRange.Rows.Count, SH.UsedRange.Columns.Count)).Clear

'Define the Lastrow and StartRow of the Data
Dim SHLastrow As Long
SHLastrow = SH.Range("A" & Rows.Count).End(xlUp).Row

Dim StartRow As Long
StartRow = 2

Dim R As Long ' R is Loop variable
Dim Numb As Integer, Output As String

'Loop through the rows
For R = StartRow To SHLastrow
ColNumb = 2
For L = 1 To Len(SH.Cells(R, 1).Value)
Numb = Mid(SH.Cells(R, 1).Value, L, 1)

If Numb = 0 Then
Output = "Zero"
ElseIf Numb = 1 Then
Output = "One"
ElseIf Numb = 2 Then
Output = "Two"
ElseIf Numb = 3 Then
Output = "Three"
ElseIf Numb = 4 Then
Output = "Four"
ElseIf Numb = 5 Then
Output = "Five"
ElseIf Numb = 6 Then
Output = "Six"
ElseIf Numb = 7 Then
Output = "Seven"
ElseIf Numb = 8 Then
Output = "Eight"
ElseIf Numb = 9 Then
Output = "Nine"
End If

SH.Cells(R, ColNumb).Value = Numb
SH.Cells(R, ColNumb + 1).Value = Output
ColNumb = ColNumb + 2
Next
Next

SH.Cells.Interior.ColorIndex = 0
SH.Cells.Borders.LineStyle = xlNone
'Apply the Background color and Borders
LastColumn = SH.UsedRange.Columns.Count
SH.Range(Cells(1, 1), Cells(SHLastrow, LastColumn)).Interior.ColorIndex = 27
SH.Range(Cells(1, 1), Cells(SHLastrow, LastColumn)).Borders.Color = vbBlack

'Format the Body
With SH.Range(Cells(2, 1), Cells(SHLastrow, LastColumn))
.Font.Name = "Estrangelo Edessa"
.Columns(1).Font.Bold = True
.HorizontalAlignment = xlLeft
End With

SH.Range("B1").Value = "Output"

'Merge the cells of First row on dynamic Basis
SH.Range(Cells(1, 2), Cells(1, LastColumn)).Merge

'Format the Range B1
With SH.Range("B1")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.Name = "Estrangelo Edessa"
.Font.Size = 18
End With

MsgBox "Hi Conversion Process Completed"
End Sub