Option Explicit

Public Function NumberToWords(ByVal Num As Variant) As String
    Dim NumberString As String
    Dim WholePart As String
    Dim DecimalPart As String
    Dim Parts() As String
    Dim Result As String
    Dim i As Integer
    
    If Not IsNumeric(Num) Then
        NumberToWords = ""
        Exit Function
    End If
    
    NumberString = Trim(CStr(Num))
    NumberString = Replace(NumberString, ",", "")
    
    If Left(NumberString, 1) = "-" Then
        Result = "Minus "
        NumberString = Mid(NumberString, 2)
    End If
    
    Parts = Split(NumberString, ".")
    WholePart = Parts(0)
    
    Result = Result & ConvertWholeNumber(WholePart)
    
    If UBound(Parts) > 0 Then
        DecimalPart = Parts(1)
        If Len(DecimalPart) > 0 Then
            Result = Result & " Point"
            For i = 1 To Len(DecimalPart)
                Result = Result & " " & DigitToWord(Mid(DecimalPart, i, 1))
            Next i
        End If
    End If
    
    NumberToWords = Application.WorksheetFunction.Trim(Result)
End Function

Private Function ConvertWholeNumber(ByVal NumberText As String) As String
    Dim Scales As Variant
    Dim GroupNumber As Integer
    Dim GroupText As String
    Dim Result As String
    Dim ScaleIndex As Integer
    
    Scales = Array("", "Thousand", "Million", "Billion", "Trillion", "Quadrillion")
    
    If Val(NumberText) = 0 Then
        ConvertWholeNumber = "Zero"
        Exit Function
    End If
    
    ScaleIndex = 0
    
    Do While Len(NumberText) > 0
        If Len(NumberText) > 3 Then
            GroupNumber = CInt(Right(NumberText, 3))
            NumberText = Left(NumberText, Len(NumberText) - 3)
        Else
            GroupNumber = CInt(NumberText)
            NumberText = ""
        End If
        
        If GroupNumber > 0 Then
            GroupText = ConvertHundreds(GroupNumber)
            If ScaleIndex > 0 Then
                GroupText = GroupText & " " & Scales(ScaleIndex)
            End If
            Result = GroupText & " " & Result
        End If
        
        ScaleIndex = ScaleIndex + 1
    Loop
    
    ConvertWholeNumber = Application.WorksheetFunction.Trim(Result)
End Function

Private Function ConvertHundreds(ByVal NumberValue As Integer) As String
    Dim Ones As Variant
    Dim Tens As Variant
    Dim Result As String
    Dim Remainder As Integer
    
    Ones = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", _
                 "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", _
                 "Sixteen", "Seventeen", "Eighteen", "Nineteen")
                 
    Tens = Array("", "", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
    
    If NumberValue >= 100 Then
        Result = Ones(NumberValue \ 100) & " Hundred"
        Remainder = NumberValue Mod 100
        
        If Remainder > 0 Then
            Result = Result & " " & ConvertHundreds(Remainder)
        End If
        
    ElseIf NumberValue >= 20 Then
        Result = Tens(NumberValue \ 10)
        
        If NumberValue Mod 10 > 0 Then
            Result = Result & " " & Ones(NumberValue Mod 10)
        End If
        
    Else
        Result = Ones(NumberValue)
    End If
    
    ConvertHundreds = Result
End Function

Private Function DigitToWord(ByVal Digit As String) As String
    Select Case Digit
        Case "0": DigitToWord = "Zero"
        Case "1": DigitToWord = "One"
        Case "2": DigitToWord = "Two"
        Case "3": DigitToWord = "Three"
        Case "4": DigitToWord = "Four"
        Case "5": DigitToWord = "Five"
        Case "6": DigitToWord = "Six"
        Case "7": DigitToWord = "Seven"
        Case "8": DigitToWord = "Eight"
        Case "9": DigitToWord = "Nine"
        Case Else: DigitToWord = ""
    End Select
End Function



Public Sub ConvertSelectedNumbersToWords()
    Dim Cell As Range
    
    For Each Cell In Selection
        If Not IsEmpty(Cell.Value) Then
            If IsNumeric(Cell.Value) Then
                Cell.Value = NumberToWords(Cell.Value)
            End If
        End If
    Next Cell
End Sub

Public Sub ConvertAllNumbersToWords_NextColumn()
    Dim Cell As Range
    
    For Each Cell In ActiveSheet.UsedRange
        If Not IsEmpty(Cell.Value) Then
            If IsNumeric(Cell.Value) Then
                If IsEmpty(Cell.Offset(0, 1).Value) Then
                    Cell.Offset(0, 1).Value = NumberToWords(Cell.Value)
                End If
            End If
        End If
    Next Cell
End Sub

Public Sub ConvertSelectedNumbersToWords_NextColumn_Overwrite()
    Dim Cell As Range
    
    For Each Cell In Selection
        If Not IsEmpty(Cell.Value) Then
            If IsNumeric(Cell.Value) Then
                Cell.Offset(0, 1).Value = NumberToWords(Cell.Value)
            End If
        End If
    Next Cell
End Sub


Public Function WordsToNumber(ByVal Txt As String) As Double
    Dim Words() As String
    Dim i As Long
    Dim Current As Double
    Dim Total As Double
    Dim IsDecimal As Boolean
    Dim DecimalPlace As Double
    Dim IsNegative As Boolean
    
    Txt = LCase(Trim(Txt))
    
    If Left(Txt, 5) = "minus" Then
        IsNegative = True
        Txt = Trim(Mid(Txt, 6))
    End If
    
    Words = Split(Txt, " ")
    
    DecimalPlace = 0.1
    
    For i = 0 To UBound(Words)
        Select Case Words(i)
            Case "zero": If IsDecimal Then Total = Total + 0 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 0
            Case "one": If IsDecimal Then Total = Total + 1 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 1
            Case "two": If IsDecimal Then Total = Total + 2 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 2
            Case "three": If IsDecimal Then Total = Total + 3 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 3
            Case "four": If IsDecimal Then Total = Total + 4 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 4
            Case "five": If IsDecimal Then Total = Total + 5 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 5
            Case "six": If IsDecimal Then Total = Total + 6 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 6
            Case "seven": If IsDecimal Then Total = Total + 7 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 7
            Case "eight": If IsDecimal Then Total = Total + 8 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 8
            Case "nine": If IsDecimal Then Total = Total + 9 * DecimalPlace: DecimalPlace = DecimalPlace / 10 Else Current = Current + 9
            
            Case "ten": Current = Current + 10
            Case "eleven": Current = Current + 11
            Case "twelve": Current = Current + 12
            Case "thirteen": Current = Current + 13
            Case "fourteen": Current = Current + 14
            Case "fifteen": Current = Current + 15
            Case "sixteen": Current = Current + 16
            Case "seventeen": Current = Current + 17
            Case "eighteen": Current = Current + 18
            Case "nineteen": Current = Current + 19
            
            Case "twenty": Current = Current + 20
            Case "thirty": Current = Current + 30
            Case "forty": Current = Current + 40
            Case "fifty": Current = Current + 50
            Case "sixty": Current = Current + 60
            Case "seventy": Current = Current + 70
            Case "eighty": Current = Current + 80
            Case "ninety": Current = Current + 90
            
            Case "hundred"
                Current = Current * 100
                
            Case "thousand"
                Total = Total + Current * 1000
                Current = 0
                
            Case "million"
                Total = Total + Current * 1000000
                Current = 0
                
            Case "billion"
                Total = Total + Current * 1000000000
                Current = 0
                
            Case "trillion"
                Total = Total + Current * 1000000000000#
                Current = 0
                
            Case "point"
                Total = Total + Current
                Current = 0
                IsDecimal = True
        End Select
    Next i
    
    Total = Total + Current
    
    If IsNegative Then Total = -Total
    
    WordsToNumber = Total
End Function

Public Sub ConvertSelectedWordsToNumbers()
    Dim Cell As Range
    
    For Each Cell In Selection
        If Not IsEmpty(Cell.Value) Then
            If VarType(Cell.Value) = vbString Then
                Cell.Value = WordsToNumber(Cell.Value)
            End If
        End If
    Next Cell
End Sub