Text To Column max 26 characters

H

Howard

With these three examples in a single cell, say A1 & A4 & A7, I have a simple macro to put each char into a individual cell (including spaces).

What I want is a 26 char limit per line, space counts as a char.
In the first line the 26th spot falls in one of the spaces, so a break there is good to put the remaining chars on the next line.

In the second line the 26th char falls between the "YP" so in this case I need to back up to the first available space before "YP" and make the break there.

The third line is less than 26 char so it needs no split, but needs to be included in the final 'each char in an individual cell' caper.

HZG MY AG AGHTO TYMVKTZ. K RHT'M ZGM YIJ; K'A

UYQTZ. XVGT K'A KT PEYTM YP HT HQJKGTRG, HII MVHM

ZGYEZG NQETO

Either of the following capers is fine with me.

1. Run the text to columns code and put the entire line in individual cells (including spaces) then run a "26 char max that does not split a word" code and have the line on two rows now.

2. Split the line as is with a "26 char max that does not split a word" code and then run the text to columns code on those lines to put each char in individual cells.

Finding that proper space to make the line break has me stumped.

Thanks,
Howard
 
C

Claus Busch

Hi Howard,

Am Wed, 26 Jun 2013 00:02:04 -0700 (PDT) schrieb Howard:
With these three examples in a single cell, say A1 & A4 & A7, I have a simple macro to put each char into a individual cell (including spaces).

What I want is a 26 char limit per line, space counts as a char.
In the first line the 26th spot falls in one of the spaces, so a break there is good to put the remaining chars on the next line.

In the second line the 26th char falls between the "YP" so in this case I need to back up to the first available space before "YP" and make the break there.

The third line is less than 26 char so it needs no split, but needs to be included in the final 'each char in an individual cell' caper.

HZG MY AG AGHTO TYMVKTZ. K RHT'M ZGM YIJ; K'A

UYQTZ. XVGT K'A KT PEYTM YP HT HQJKGTRG, HII MVHM

ZGYEZG NQETO
Click to expand...

try:

Sub Test()
Const maxLen As Integer = 26
Dim Str1 As String
Dim Str2 As String
Dim Str3 As String


Str1 = IIf(Len([A1]) > maxLen, Left([A1], _
InStrRev([A1], " ", maxLen + 1)), [A1])

Str2 = IIf(Len([A4]) > maxLen, Left([A4], _
InStrRev([A4], " ", maxLen + 1)), [A4])

Str3 = IIf(Len([A7]) > maxLen, Left([A7], _
InStrRev([A7], " ", maxLen + 1)), [A7])

[A10] = Str1 & Str2 & Str3
End Sub


Regards
Claus Busch
 
C

Claus Busch

Hi Howard,

sorry, I didn't read carefully.
Try:

Sub Test()
Const maxLen As Integer = 26

[A1] = IIf(Len([A1]) > maxLen, Left([A1], _
InStrRev([A1], " ", maxLen)), [A1])

[A4] = IIf(Len([A4]) > maxLen, Left([A4], _
InStrRev([A4], " ", maxLen)), [A4])

[A7] = IIf(Len([A7]) > maxLen, Left([A7], _
InStrRev([A7], " ", maxLen)), [A7])

Columns("A").TextToColumns Destination:=Range("B1"),
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(2, 1), Array(3, 1),
_
Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1),
_
Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1),
_
Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1),
_
Array(24, 1), Array(25, 1), Array(26, 1)), TrailingMinusNumbers:=True
End Sub


Regards
Claus Busch
 
H

Howard

Hi Howard,



sorry, I didn't read carefully.

Try:



Sub Test()

Const maxLen As Integer = 26



[A1] = IIf(Len([A1]) > maxLen, Left([A1], _

InStrRev([A1], " ", maxLen)), [A1])



[A4] = IIf(Len([A4]) > maxLen, Left([A4], _

InStrRev([A4], " ", maxLen)), [A4])



[A7] = IIf(Len([A7]) > maxLen, Left([A7], _

InStrRev([A7], " ", maxLen)), [A7])



Columns("A").TextToColumns Destination:=Range("B1"),

DataType:=xlFixedWidth, _

FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(2, 1), Array(3, 1),

_

Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _

Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1),

_

Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1),

_

Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1),

_

Array(24, 1), Array(25, 1), Array(26, 1)), TrailingMinusNumbers:=True

End Sub
Click to expand...
Regards

Claus Busch
Click to expand...

This second code nails it spot on!!
I was thinking I had an out side chance to figure it out on my own, but after seeing this work, I would have never got there.

Thanks, Claus.

Regards,
Howard
 
C

Claus Busch

Hi Howard,

Am Wed, 26 Jun 2013 00:50:07 -0700 (PDT) schrieb Howard:
I was thinking I had an out side chance to figure it out on my own, but after seeing this work, I would have never got there.
Click to expand...

glad to help. Thank you for the feedback.
Instead of TextToColumns you can do it with formula:
Sub Test()
Const maxLen As Integer = 26

[A1] = IIf(Len([A1]) > maxLen, Left([A1], _
InStrRev([A1], " ", maxLen)), [A1])

[A4] = IIf(Len([A4]) > maxLen, Left([A4], _
InStrRev([A4], " ", maxLen)), [A4])

[A7] = IIf(Len([A7]) > maxLen, Left([A7], _
InStrRev([A7], " ", maxLen)), [A7])

Range("B1:AA1").Formula = "=mid($A$1,column(A1),1)"
Range("B4.AA4").Formula = "=mid($A$4,column(A4),1)"
Range("B7:AA7").Formula = "=mid($A$7,column(A7),1)"
Range("B1:AA1").Value = Range("B1:AA1").Value
Range("B4.AA4").Value = Range("B4.AA4").Value
Range("B7:AA7").Value = Range("B7:AA7").Value

End Sub


Regards
Claus Busch
 
H

Howard

Hi Howard,



Am Wed, 26 Jun 2013 00:50:07 -0700 (PDT) schrieb Howard:


I was thinking I had an out side chance to figure it out on my own, but after seeing this work, I would have never got there.
Click to expand...



glad to help. Thank you for the feedback.

Instead of TextToColumns you can do it with formula:

Sub Test()

Const maxLen As Integer = 26



[A1] = IIf(Len([A1]) > maxLen, Left([A1], _

InStrRev([A1], " ", maxLen)), [A1])



[A4] = IIf(Len([A4]) > maxLen, Left([A4], _

InStrRev([A4], " ", maxLen)), [A4])



[A7] = IIf(Len([A7]) > maxLen, Left([A7], _

InStrRev([A7], " ", maxLen)), [A7])



Range("B1:AA1").Formula = "=mid($A$1,column(A1),1)"

Range("B4.AA4").Formula = "=mid($A$4,column(A4),1)"

Range("B7:AA7").Formula = "=mid($A$7,column(A7),1)"

Range("B1:AA1").Value = Range("B1:AA1").Value

Range("B4.AA4").Value = Range("B4.AA4").Value

Range("B7:AA7").Value = Range("B7:AA7").Value



End Sub





Regards

Claus Busch
Click to expand...


Okay, I'll give that a try also, but I find that the previous code looses some of the text. I'm still enthused though.

If I run the code on this line only, it makes the break between the "." (period) and the next letter "K". That is perfect. However, I am now missing the rest of the line which I assumed would be placed below the first 26 max char's.

Me thinks I misled you in my explanation.

HZG MY AG AGHTO TYMVKTZ. K RHT'M ZGM YIJ; K'A

So with the line above I would want it to wind up like this.

HZG MY AG AGHTO TYMVKTZ.

K RHT'M ZGM YIJ; K'A

Then the text to columns code should run pretty much like you have it.

Howard
 
C

Claus Busch

Hi Howard,
So with the line above I would want it to wind up like this.

HZG MY AG AGHTO TYMVKTZ.

K RHT'M ZGM YIJ; K'A
Click to expand...

then try:

Sub Test2()
Const maxLen As Integer = 26
Dim Str1 As String
Dim i As Integer

For i = 1 To 7 Step 3
Str1 = ""
Str1 = IIf(Len(Cells(i, 1)) > maxLen, Left(Cells(i, 1), _
InStrRev(Cells(i, 1), " ", maxLen)), Cells(i, 1))
Cells(i, 1).Offset(1, 0) = Replace(Cells(i, 1), Str1, "")
Cells(i, 1) = Str1
Next

Columns("A").TextToColumns Destination:=Range("B1"), _
DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), _
Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), _
Array(25, 1), Array(26, 1)), TrailingMinusNumbers:=True
End Sub


Regards
Claus Busch
 
H

Howard

Hi Howard,






then try:



Sub Test2()

Const maxLen As Integer = 26

Dim Str1 As String

Dim i As Integer



For i = 1 To 7 Step 3

Str1 = ""

Str1 = IIf(Len(Cells(i, 1)) > maxLen, Left(Cells(i, 1), _

InStrRev(Cells(i, 1), " ", maxLen)), Cells(i, 1))

Cells(i, 1).Offset(1, 0) = Replace(Cells(i, 1), Str1, "")

Cells(i, 1) = Str1

Next



Columns("A").TextToColumns Destination:=Range("B1"), _

DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _

Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _

Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _

Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), _

Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _

Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _

Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), _

Array(25, 1), Array(26, 1)), TrailingMinusNumbers:=True

End Sub

Regards

Claus Busch
Click to expand...


Very nice, that has me right where I need to be.
I'll do some local tweaking on the sheet, but getting that "max 26 char on two lines split" is awesome to me. Love it.

Thank again, Claus.

Regards,
Howard
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Removing words from a string? 4
Save Text to File 4
Text to Column with fixed width in VBA 1
Parsing an excel doc to find max values 0
VBA to Find Key Words in Word doc then Extract Content to Excel.xlsm file 3
How to do a line break in a text formula 2
Data Split and graph problem 8
Text to Column with fixed width 2

Top