Hello eveyone,
I have the following macro that is used to type checks by converting no's to words, the problem that i've is when i use this macro on cells merged vertically it will repeat the word "only" based on the number of rows merged " cells vertically merged" I don't want "only" to be repeated & i want to keep the cells as merged.
Please help.
I have the following macro that is used to type checks by converting no's to words, the problem that i've is when i use this macro on cells merged vertically it will repeat the word "only" based on the number of rows merged " cells vertically merged" I don't want "only" to be repeated & i want to keep the cells as merged.
Please help.
Sub Text2Num()
If Application.IsNumber(ActiveCell) = True Then
Dim MyNum, Num1, NumLength, txString
Dim Million, Thousand, Hundred, myDecimal
Dim MyDollar, MyCent
Dim Space, Separator
Dim Digit1, Digit2, Digit3, Digit4, Digit5
Dim Digit6, Digit7, Digit8, Digit9
Dim Digit11, Digit12 'Decimals
Dim txRM
Dim Rng, i
Rng = Selection.Rows.Count
For i = 1 To Rng
MyDollar = "SR: " 'Must be within the
MyCent = "HALALAS " 'For Next Loop
'--------------------------------------------------
Digit1 = 0 'Resets numbers
Digit2 = 0
Digit3 = 0
Digit4 = 0
Digit5 = 0
Digit6 = 0
Digit7 = 0
Digit8 = 0
Digit9 = 0
Digit11 = 0
Digit12 = 0
Million = ""
Thousand = ""
Hundred = ""
myDecimal = ""
'--------------------------------------------------
Num1 = ActiveCell
MyNum = Format(Num1, "#0.00") 'Shows 2 decimal places
NumLength = Len(MyNum) 'Determines the length of the number
Select Case NumLength 'Length determines the
Case 12 'position of the text boxes
Digit1 = Mid(MyNum, 1, 1)
Digit2 = Mid(MyNum, 2, 1)
Digit3 = Mid(MyNum, 3, 1)
Digit4 = Mid(MyNum, 4, 1)
Digit5 = Mid(MyNum, 5, 1)
Digit6 = Mid(MyNum, 6, 1)
Digit7 = Mid(MyNum, 7, 1)
Digit8 = Mid(MyNum, 8, 1)
Digit9 = Mid(MyNum, 9, 1)
Digit11 = Mid(MyNum, 11, 1)
Digit12 = Mid(MyNum, 12, 1)
Case 11
Digit2 = Mid(MyNum, 1, 1)
Digit3 = Mid(MyNum, 2, 1)
Digit4 = Mid(MyNum, 3, 1)
Digit5 = Mid(MyNum, 4, 1)
Digit6 = Mid(MyNum, 5, 1)
Digit7 = Mid(MyNum, 6, 1)
Digit8 = Mid(MyNum, 7, 1)
Digit9 = Mid(MyNum, 8, 1)
Digit11 = Mid(MyNum, 10, 1)
Digit12 = Mid(MyNum, 11, 1)
Case 10
Digit3 = Mid(MyNum, 1, 1)
Digit4 = Mid(MyNum, 2, 1)
Digit5 = Mid(MyNum, 3, 1)
Digit6 = Mid(MyNum, 4, 1)
Digit7 = Mid(MyNum, 5, 1)
Digit8 = Mid(MyNum, 6, 1)
Digit9 = Mid(MyNum, 7, 1)
Digit11 = Mid(MyNum, 9, 1)
Digit12 = Mid(MyNum, 10, 1)
Case 9
Digit4 = Mid(MyNum, 1, 1)
Digit5 = Mid(MyNum, 2, 1)
Digit6 = Mid(MyNum, 3, 1)
Digit7 = Mid(MyNum, 4, 1)
Digit8 = Mid(MyNum, 5, 1)
Digit9 = Mid(MyNum, 6, 1)
Digit11 = Mid(MyNum, 8, 1)
Digit12 = Mid(MyNum, 9, 1)
Case 8
Digit5 = Mid(MyNum, 1, 1)
Digit6 = Mid(MyNum, 2, 1)
Digit7 = Mid(MyNum, 3, 1)
Digit8 = Mid(MyNum, 4, 1)
Digit9 = Mid(MyNum, 5, 1)
Digit11 = Mid(MyNum, 7, 1)
Digit12 = Mid(MyNum, 8, 1)
Case 7
Digit6 = Mid(MyNum, 1, 1)
Digit7 = Mid(MyNum, 2, 1)
Digit8 = Mid(MyNum, 3, 1)
Digit9 = Mid(MyNum, 4, 1)
Digit11 = Mid(MyNum, 6, 1)
Digit12 = Mid(MyNum, 7, 1)
Case 6
Digit7 = Mid(MyNum, 1, 1)
Digit8 = Mid(MyNum, 2, 1)
Digit9 = Mid(MyNum, 3, 1)
Digit11 = Mid(MyNum, 5, 1)
Digit12 = Mid(MyNum, 6, 1)
Case 5
Digit8 = Mid(MyNum, 1, 1)
Digit9 = Mid(MyNum, 2, 1)
Digit11 = Mid(MyNum, 4, 1)
Digit12 = Mid(MyNum, 5, 1)
Case 4
Digit9 = Mid(MyNum, 1, 1)
Digit11 = Mid(MyNum, 3, 1)
Digit12 = Mid(MyNum, 4, 1)
Case 3
Digit11 = Mid(MyNum, 2, 1)
Digit12 = Mid(MyNum, 3, 1)
Case 2
Digit12 = Mid(MyNum, 2, 1)
End Select
'--------------------------------------------------
'''Do million
If Digit1 <> 0 Or Digit2 <> 0 Or Digit3 <> 0 Then
Million = "MILLION "
End If
Dim M1
M1 = Digit1
Select Case M1
Case 0
M1 = ""
Case 1
M1 = "ONE HUNDRED "
Case 2
M1 = "TWO HUNDRED "
Case 3
M1 = "THREE HUNDRED "
Case 4
M1 = "FOUR HUNDRED "
Case 5
M1 = "FIVE HUNDRED "
Case 6
M1 = "SIX HUNDRED "
Case 7
M1 = "SEVEN HUNDRED "
Case 8
M1 = "EIGHT HUNDRED "
Case 9
M1 = "NINE HUNDRED "
End Select
Dim M2
M2 = Digit2
Select Case M2
Case 0
M2 = ""
Case 1
M2 = ""
Case 2
M2 = "TWENTY "
Case 3
M2 = "THIRTY "
Case 4
M2 = "FORTY "
Case 5
M2 = "FIFTY "
Case 6
M2 = "SIXTY "
Case 7
M2 = "SEVENTY "
Case 8
M2 = "EIGHTY "
Case 9
M2 = "NINETY "
End Select
Dim M3
M3 = Digit3
If Digit2 = 1 Then 'check against the number before
Select Case M3
Case 0
M3 = "TEN "
Case 1
M3 = "ELEVEN "
Case 2
M3 = "TWELVE "
Case 3
M3 = "THIRTEEN "
Case 4
M3 = "FOURTEEN "
Case 5
M3 = "FIFTEEN "
Case 6
M3 = "SIXTEEN "
Case 7
M3 = "SEVENTEEN "
Case 8
M3 = "EIGHTEEN "
Case 9
M3 = "NINETEEN "
End Select
Else
Select Case M3
Case 0
M3 = ""
Case 1
M3 = "ONE "
Case 2
M3 = "TWO "
Case 3
M3 = "THREE "
Case 4
M3 = "FOUR "
Case 5
M3 = "FIVE "
Case 6
M3 = "SIX "
Case 7
M3 = "SEVEN "
Case 8
M3 = "EIGHT "
Case 9
M3 = "NINE "
End Select
End If
Million = M1 & M2 & M3 & Million
'----------------------------------------------------
'''Do thousand
If Digit4 <> 0 Or Digit5 <> 0 Or Digit6 <> 0 Then
Thousand = "THOUSAND "
End If
Dim T1
T1 = Digit4
Select Case T1
Case 0
T1 = ""
Case 1
T1 = "ONE HUNDRED "
Case 2
T1 = "TWO HUNDRED "
Case 3
T1 = "THREE HUNDRED "
Case 4
T1 = "FOUR HUNDRED "
Case 5
T1 = "FIVE HUNDRED "
Case 6
T1 = "SIX HUNDRED "
Case 7
T1 = "SEVEN HUNDRED "
Case 8
T1 = "EIGHT HUNDRED "
Case 9
T1 = "NINE HUNDRED "
End Select
Dim T2
T2 = Digit5
Select Case T2
Case 0
T2 = ""
Case 1
T2 = ""
Case 2
T2 = "TWENTY "
Case 3
T2 = "THIRTY "
Case 4
T2 = "FORTY "
Case 5
T2 = "FIFTY "
Case 6
T2 = "SIXTY "
Case 7
T2 = "SEVENTY "
Case 8
T2 = "EIGHTY "
Case 9
T2 = "NINETY "
End Select
Dim T3
T3 = Digit6
If Digit5 = 1 Then 'check against the number before
Select Case T3
Case 0
T3 = "TEN "
Case 1
T3 = "ELEVEN "
Case 2
T3 = "TWELVE "
Case 3
T3 = "THIRTEEN "
Case 4
T3 = "FOURTEEN "
Case 5
T3 = "FIFTEEN "
Case 6
T3 = "SIXTEEN "
Case 7
T3 = "SEVENTEEN "
Case 8
T3 = "EIGHTEEN "
Case 9
T3 = "NINETEEN "
End Select
Else
Select Case T3
Case 0
T3 = ""
Case 1
T3 = "ONE "
Case 2
T3 = "TWO "
Case 3
T3 = "THREE "
Case 4
T3 = "FOUR "
Case 5
T3 = "FIVE "
Case 6
T3 = "SIX "
Case 7
T3 = "SEVEN "
Case 8
T3 = "EIGHT "
Case 9
T3 = "NINE "
End Select
End If
Thousand = T1 & T2 & T3 & Thousand
'----------------------------------------------------
'''Do hundred
If Digit6 <> 0 Or Digit7 <> 0 Or Digit8 <> 0 Then
Hundred = "HUNDRED "
End If
Dim H1
H1 = Digit7
Select Case H1
Case 0
H1 = ""
Case 1
H1 = "ONE HUNDRED "
Case 2
H1 = "TWO HUNDRED "
Case 3
H1 = "THREE HUNDRED "
Case 4
H1 = "FOUR HUNDRED "
Case 5
H1 = "FIVE HUNDRED "
Case 6
H1 = "SIX HUNDRED "
Case 7
H1 = "SEVEN HUNDRED "
Case 8
H1 = "EIGHT HUNDRED "
Case 9
H1 = "NINE HUNDRED "
End Select
Dim H2
H2 = Digit8
Select Case H2
Case 0
H2 = ""
Case 1
H2 = ""
Case 2
H2 = "TWENTY "
Case 3
H2 = "THIRTY "
Case 4
H2 = "FORTY "
Case 5
H2 = "FIFTY "
Case 6
H2 = "SIXTY "
Case 7
H2 = "SEVENTY "
Case 8
H2 = "EIGHTY "
Case 9
H2 = "NINETY "
End Select
Dim H3
H3 = Digit9
If Digit8 = 1 Then 'check against the number before
Select Case H3
Case 0
H3 = "TEN "
Case 1
H3 = "ELEVEN "
Case 2
H3 = "TWELVE "
Case 3
H3 = "THIRTEEN "
Case 4
H3 = "FOURTEEN "
Case 5
H3 = "FIFTEEN "
Case 6
H3 = "SIXTEEN "
Case 7
H3 = "SEVENTEEN "
Case 8
H3 = "EIGHTEEN "
Case 9
H3 = "NINETEEN "
End Select
Else
Select Case H3
Case 0
H3 = ""
Case 1
H3 = "ONE "
Case 2
H3 = "TWO "
Case 3
H3 = "THREE "
Case 4
H3 = "FOUR "
Case 5
H3 = "FIVE "
Case 6
H3 = "SIX "
Case 7
H3 = "SEVEN "
Case 8
H3 = "EIGHT "
Case 9
H3 = "NINE "
End Select
End If
Hundred = H1 & H2 & H3
'----------------------------------------------------
'Do decimal
Dim D1
D1 = Digit11
Select Case D1
Case 0
D1 = ""
Case 1
D1 = ""
Case 2
D1 = "TWENTY "
Case 3
D1 = "THIRTY "
Case 4
D1 = "FORTY "
Case 5
D1 = "FIFTY "
Case 6
D1 = "SIXTY "
Case 7
D1 = "SEVENTY "
Case 8
D1 = "EIGHTY "
Case 9
D1 = "NINETY "
End Select
Dim D2
D2 = Digit12
If Digit11 = 1 Then 'check against the number before
Select Case D2
Case 0
D2 = "TEN "
Case 1
D2 = "ELEVEN "
Case 2
D2 = "TWELVE "
Case 3
D2 = "THIRTEEN "
Case 4
D2 = "FOURTEEN "
Case 5
D2 = "FIFTEEN "
Case 6
D2 = "SIXTEEN "
Case 7
D2 = "SEVENTEEN "
Case 8
D2 = "EIGHTEEN "
Case 9
D2 = "NINETEEN "
End Select
Else
Select Case D2
Case 0
D2 = ""
Case 1
D2 = "ONE "
Case 2
D2 = "TWO "
Case 3
D2 = "THREE "
Case 4
D2 = "FOUR "
Case 5
D2 = "FIVE "
Case 6
D2 = "SIX "
Case 7
D2 = "SEVEN "
Case 8
D2 = "EIGHT "
Case 9
D2 = "NINE "
End Select
End If
myDecimal = D1 & D2
'--------------------------------------------------
'--------------------------------------------------
If Million = "" And Thousand = "" And Hundred = "" Then
MyDollar = ""
Space = ""
Separator = ""
Else: Space = " "
Separator = "& "
End If
If myDecimal = "" Then
MyCent = ""
Separator = ""
End If
If txRM = "" Then
Space = "" 'So that the 1st digit will not have a gap in front
End If
txString = MyDollar & Space & Million & Thousand & Hundred & Separator & MyCent & myDecimal & "ONLY."
ActiveCell = txString
ActiveCell.Offset(1, 0).Select
Next i
Exit Sub
Else
MsgBox "The cell must contain a number", vbCritical, "Naveed "
End If
End Sub
Last edited:
