Converting currency to text and spliting to two lines

[colm o'brien]

I have mangaged trough a google search to get the code to convert currency in
cell to text in another for printing cheques etc.

The problem is that once the text exceeds 40 characters i need it to go onto
another line.

Can someone please advise how i can split this at a space if more than 40
characters and put second half in a specific cell.

eg line one of text is in cell B2 and Line two in cell B4

so Cell B2 would say "Five Hundred and Sixty Five Pounds and Twenty"
and cell b4 would say "five Pence"
The conversion code is below.


'****************

' Main Function *

'****************



Function SpellNumber(ByVal MyNumber)

Dim Pounds, Pence, Temp

Dim DecimalPlace, Count



ReDim Place(9) As String

Place(2) = " Thousand "

Place(3) = " Million "

Place(4) = " Billion "

Place(5) = " Trillion "



' String representation of amount.

MyNumber = Trim(Str(MyNumber))



' Position of decimal place 0 if none.

DecimalPlace = InStr(MyNumber, ".")

' Convert Pence and set MyNumber to Pound amount.

If DecimalPlace > 0 Then

Pence = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))

MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

End If



Count = 1

Do While MyNumber <> ""

Temp = GetHundreds(Right(MyNumber, 3))

If Temp <> "" Then Pounds = Temp & Place(Count) & Pounds

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = ""

End If

Count = Count + 1

Loop



Select Case Pounds

Case ""

Pounds = "No Pounds"

Case "One"

Pounds = "One Pound"

Case Else

Pounds = Pounds & " Pounds"

End Select



Select Case Pence

Case ""

Pence = " and No Pence"

Case "One"

Pence = " and One Penny"

Case Else

Pence = " and " & Pence & " Pence"

End Select



SpellNumber = Pounds & Pence

End Function







'*******************************************

' Converts a number from 100-999 into text *

'*******************************************



Function GetHundreds(ByVal MyNumber)

Dim Result As String



If Val(MyNumber) = 0 Then Exit Function

MyNumber = Right("000" & MyNumber, 3)



' Convert the hundreds place.

If Mid(MyNumber, 1, 1) <> "0" Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

End If



' Convert the tens and ones place.

If Mid(MyNumber, 2, 1) <> "0" Then

Result = Result & GetTens(Mid(MyNumber, 2))

Else

Result = Result & GetDigit(Mid(MyNumber, 3))

End If



GetHundreds = Result

End Function







'*********************************************

' Converts a number from 10 to 99 into text. *

'*********************************************



Function GetTens(TensText)

Dim Result As String



Result = "" ' Null out the temporary function value.

If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...

Select Case Val(TensText)

Case 10: Result = "Ten"

Case 11: Result = "Eleven"

Case 12: Result = "Twelve"

Case 13: Result = "Thirteen"

Case 14: Result = "Fourteen"

Case 15: Result = "Fifteen"

Case 16: Result = "Sixteen"

Case 17: Result = "Seventeen"

Case 18: Result = "Eighteen"

Case 19: Result = "Nineteen"

Case Else

End Select

Else ' If value between 20-99...

Select Case Val(Left(TensText, 1))

Case 2: Result = "Twenty "

Case 3: Result = "Thirty "

Case 4: Result = "Forty "

Case 5: Result = "Fifty "

Case 6: Result = "Sixty "

Case 7: Result = "Seventy "

Case 8: Result = "Eighty "

Case 9: Result = "Ninety "

Case Else

End Select

Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.

End If

GetTens = Result

End Function









'*******************************************

' Converts a number from 1 to 9 into text. *

'*******************************************



Function GetDigit(Digit)

Select Case Val(Digit)

Case 1: GetDigit = "One"

Case 2: GetDigit = "Two"

Case 3: GetDigit = "Three"

Case 4: GetDigit = "Four"

Case 5: GetDigit = "Five"

Case 6: GetDigit = "Six"

Case 7: GetDigit = "Seven"

Case 8: GetDigit = "Eight"

Case 9: GetDigit = "Nine"

Case Else: GetDigit = ""

End Select

End Function

 

[Rick Rothstein]

Do you really want the split text placed in separate cells as opposed to being placed on separate lines within the same cell? The problem with using separate cells is what if the text is long enough to require three lines? Here is a function (you can use is on the worksheet as a UDF or as a normal function inside your own code which outputs the text with Line Feeds at the breakpoints you requested. My function calls your SpellNumber function, so all you have to pass it is the number and it will take care of spelling it out and then splitting it. You do have to remember to set the cell format to "Wrap Text" and widen the column (autofit maybe) so that it is wide enough to display the long line part of the spelled out number.

Function SplitAt40Chars(ByVal TextVal As String) As String
Dim Blank As Long, Beginning As String, Remainder As String
Const MaxCharsPerLine As Long = 40
TextVal = SpellNumber(TextVal)
Blank = InStrRev(Left(TextVal, MaxCharsPerLine), " ")
Do While Blank > 0
SplitAt40Chars = SplitAt40Chars & Left(TextVal, Blank - 1) & vbLf
Remainder = Mid(TextVal, Blank + 1)
Blank = InStrRev(Remainder, MaxCharsPerLine)
Loop
If Right(Remainder, 1) = vbLf Then
Remainder = Left(Remainder, Len(Remainder) - 1)
End If
SplitAt40Chars = SplitAt40Chars & Remainder
End Function

 

[Faraz A. Qureshi]

Why not use simply the left and right function as follows:
=LEFT(SpellNumber(INPUT),40) In B2 and
=RIGHT(SpellNumber(INPUT),Len(SpellNumber(INPUT))-40)
Input being your number?

 

[Rick Rothstein]

Because splitting the text at exactly 40 characters might split the text in the middle of a word... the OP said he wanted it spilt at a space character.

 

[colm o'brien]

That would be fine if there was always a split at that point for example 128.69

would put the two lines as
"One Hundred and Twenty Eight Pounds and Sixt"
"y Nine Pence"

but that's a step in the right direction.

Thanks

 

[Faraz A. Qureshi]

Further refined:

A1 consisting the figure

In B1:
=LEFT(SpellNumber(A1),MIN(40,LEN(SpellNumber(A1))))

and in C2
=If(LEN(A1)>40,RIGHT(SpellNumber(A1),LEN(SpellNumber(A1))-40),"")

Best Regards,

Faraz

 

[colm o'brien]

Rick

Thanks for your guidance.
Because it is printing on a cheque i wanted to have separate cells so lines
of text were correcly spaced on paper cheque. I suppose i could try spacing
the lines within the cell but thought that might be messy.

I copied your code into vba module but can't seem to call tour function.

i assume cell b2 the formula should be "=splitat40(g7)"

but i get a #name? error

Thanks

Colm

 

[Rick Rothstein]

You are getting a #Name? error because you didn't use the name I gave the function... try using SplitAt40Chars instead (notices the last five characters that you left off). If you really want the output in separate cells, that can be done; however, doing that raises the question "which cells"? Your example showed putting the 2nd split out line two cells down from the first line (B4 and B2 respectively)... where would you want the 3rd line to go if the text was long enough to need splitting into 3 lines? What about 4 lines?

 

[Faraz A. Qureshi]

Checkout Rick's xclent post!

 

[OssieMac]

I think Rick might have left a line that was being used during testing.
Delete the following line.

TextVal = SpellNumber(TextVal)

TextVal is a string and SpellNumber requires numeric.

then call the function like this

=SplitAt40Chars(SpellNumber(C1))

 

[colm o'brien]

Thanks Rick

That works (stupid Me) but to as i have a currently have template set up
where i have been manually entering text and currency and automating the
process would be more beneficial.
my current template is for printing on blank standard cheques and the 2
lines between text is required so the ideal would be line 1 at cell b2, line
2 at cell b4, line 3 at b6 of course as these are cheques for a small
business or home user it's unlikely to go to three line but i appreciate the
possibility, and your foresight.
Unless of course you can advise how to put the extra space between the lines
in the wrapped text.

Thanks for all your help

 

[Faraz A. Qureshi]

Right 4 sure!
It was quite a great and comprehensive sample u provided there.

 

[OssieMac]

Hi Colm,

I decided to create a generic function for splitting text into lines.
The user gets to input the max number of characters per line
and also the number of line feed between lines.
Number of line feeds is optional and defaults to 1 if not entered.

As always I am interested in any input from anyone to improve it.

Function SplitStr(strToSplt As String, _
lngMax As Long, _
Optional lngLFs As Long = 1)

Dim arrStr()
Dim lngFirst As Long
Dim lngStart As Long
Dim lngSpace As Long
Dim strLFs As String
Dim i As Long

If Len(strToSplt) <= lngMax Then
'Not long enough to split
SplitStr = strToSplt
Exit Function
End If

'String for number of Line Feeds between lines
For i = 1 To lngLFs
strLFs = strLFs & vbLf
Next i

lngStart = lngMax
lngFirst = 0
i = 0

Do
If lngStart <= Len(strToSplt) Then
lngSpace = InStrRev(strToSplt, " ", _
lngStart)

i = i + 1
ReDim Preserve arrStr(1 To i)
arrStr(i) = Mid(strToSplt, lngFirst + 1, _
lngSpace - lngFirst)

lngFirst = lngSpace
lngStart = lngFirst + lngMax

Else
i = i + 1
ReDim Preserve arrStr(1 To i)
arrStr(i) = Mid(strToSplt, lngFirst + 1)
Exit Do
End If
Loop

For i = 1 To UBound(arrStr())
SplitStr = SplitStr & arrStr(i) & strLFs
Next i

SplitStr = Left(SplitStr, Len(SplitStr) - lngLFs)

End Function

Parameters for the function as follows
=SplitStr(string To Split, max chrs per Line, Linefeeds between lines)

Example where A1 is the numeric value being converted
to words with SpellNumber and default one line feed between lines.
=SplitStr(SpellNumber(A1),40)

As above but three line feed between lines.
=SplitStr(SpellNumber(A1),40,3)

SpellNumber(A1) can be replaced with any text or cell with text.

 

[colm o'brien]

Thanks ossieMac That's exactly the result i wanted.

Thanks to all the other contributors as bit by bit you have resolved my
problem

 

[OssieMac]

To All who view this thread,

I found some bugs in the function code. I think I have them sorted now. Also
added another Argument/Parameter in case the string does not have spaces
within the specified max line length. Option is True or False depending
whether the user wants to break at the line length or return an error.

Funtion details:-
=SplitStr(String to split, Max line length, Numb LFs, If no spaces in line
lgth)

=SplitStr(A12,40,1,TRUE)

Where A12 holds the required string.
40 is the max length of each line.
1 is the number of line feeds between lines.
TRUE is break if no spaces within max line length.

Note that the cell with the result needs to be formatted to wrap text. I
used the following calculate event to handle column width and wrap text.

Private Sub Worksheet_Calculate()
'Need to first set width exceeding max line length
'otherwise AutoFit does not work with Wrap Text.
Columns("B").ColumnWidth = 60
'Reset to AutoFit
Columns("B").AutoFit
Cells.Rows.AutoFit
End Sub

Function SplitStr(strToSplit As String, _
MaxLgth As Long, _
Optional NumbLFs As Long = 1, _
Optional brkNoSpace As Boolean = True)

'Splits string at spaces.
'However,if brkNoSpace = True then
'if space intervals are greater than MaxLgth
'then the string is split at MaxLgth.

'If brkNoSpace = False Then returns
'#VALUE! error if space intervals are
'greater than MaxLgth.

Dim arrStr()
Dim spacePos As Long 'Position of Space
Dim strLFs As String 'Linefeeds
Dim i As Long
Dim strRight As String 'Remaining part of string

'Initialize string to process
'as entire string to split.
strRight = Trim(strToSplit)

If Len(strRight) > 0 Then
If Len(strToSplit) <= MaxLgth Then
'Not long enough to split
SplitStr = strToSplit
Exit Function
End If
Else
'Can't split zero length string
SplitStr = CVErr(xlErrValue)
Exit Function
End If

'String for number of Line Feeds between lines.
For i = 1 To NumbLFs
strLFs = strLFs & vbLf
Next i

i = 0 'Initialize

Do
i = i + 1
ReDim Preserve arrStr(1 To i)
If Len(strRight) > MaxLgth Then
'Find position of space
spacePos = InStrRev(strRight, " ", MaxLgth + 1)

If spacePos = 0 Then 'No space found
If brkNoSpace = True Then
'Break at MaxLgth characters anyway
spacePos = MaxLgth
Else
'Return error due to space intervals
'greater than MaxLgth
SplitStr = CVErr(xlErrValue)
Exit Function
End If
End If

'Assign portion of string to array element
arrStr(i) = Trim(Left(strRight, spacePos))

'Assign remainder of string to variable
'Trim allows for multiple spaces at break point.
'spacePos + 1 required in case no space and
'brkNoSpace = True
strRight = Trim(Mid(strRight, spacePos + 1))

Else
'Last portion of string (<= MaxLgth)
arrStr(i) = Trim(strRight)
Exit Do
End If
Loop

'Assign array values to single string
'with line feed/s between the array values
For i = 1 To UBound(arrStr())
SplitStr = SplitStr & arrStr(i) & strLFs
Next i

'Remove trailing linefeeds
SplitStr = Left(SplitStr, Len(SplitStr) - Len(strLFs))

End Function