Counting Characters To 60 And Shift to Next Column (Shift Right)

[abitspecial]

Hi all,

I've had a good look and I can't find exactly what I'm looking for which is:

I get a spreadsheet with, sometimes, 500 chars in a cell. I want to load this data to an application but I can only load up to 60 characters per column (for reasons I shan't bore you). Therefore I want to split the data in to separate columns. I can't use text to columns as I need something a little more sophisticated as I don't want to split a word in half; I'd want to move the cursor back to the start of that word and move from there to the next column. I then want to repeat that until all of the cell is split down into chunks of 60 (or less).

For example I have two cells containing the following (don't worry I've anonymised the data):

Cell 1:
If the person makes contact stating they have received a letter regarding the red survey please refer them to John Smith.
Cell 2:
If the person makes contact stating they have received a letter regarding the Yellow survey please refer them to Joe Bloggs / John S Smith OPS

If I use text to columns it will split the word 'letter' but I want it (I presume it will be a macro) to go back to the start of the word letter and move that into the next column (with upto 54 other chars).

Obviously if I only had two cells I'd do this manually but sometimes I can have thousands of cells.

Sorry if I haven't explained this very well. What I really want is similar to the below but I want the data moved to the next column (the column to the right will always be null) rather than creating a new row.

Similar thread: http://www.mrexcel.com/forum/excel-questions/400646-counting-characters-50-adding-new-line.html

I'm currently using Windows XP and Excel 2003 (as my workplace is still in the dark ages).

Thanks,

Matt

 

[XOR LX]

Hi,

I imagine a VBA-based solution would be far more efficient for you here, but, assuming your first entry is in A1, enter these array formulae (important that you know how to enter this type of formula in Excel):

In B1:

=MID(A1,1,60-MATCH(TRUE,NOT(ISNUMBER(MATCH(MID(UPPER(A1),60-(ROW($1:$60)-1),1),CHAR(ROW($65:$90)),0))),0))

In C1 and copy to the right as far as required:

=MID($A1,SUM(LEN($B1:B1))+1,60-MATCH(TRUE,NOT(ISNUMBER(MATCH(MID(UPPER($A1),SUM(60,LEN($B1:B1))-(ROW($1:$60)-1),1),CHAR(ROW($65:$90)),0))),0))

These formulae may then be copied down to give successive results for entries in A2, A3,..., etc.

Regards

 

[MickG]

Try this:-
For Data in Column "A"

[COLOR="Navy"]Sub[/COLOR] MG27Sep07
[COLOR="Navy"]Dim[/COLOR] Rng     [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dn      [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] oCols
[COLOR="Navy"]Dim[/COLOR] Dic     [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] oChr    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c       [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K
[COLOR="Navy"]Dim[/COLOR] temp    [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] str     [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw      [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] ray()   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
Const NumCount = 60
Application.ScreenUpdating = False
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.count).End(xlUp))
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Len(Dn) > NumCount [COLOR="Navy"]Then[/COLOR]
    temp = 0
    c = 0
    [COLOR="Navy"]For[/COLOR] oChr = 1 To Len(Dn)
        [COLOR="Navy"]If[/COLOR] Dn.Characters(oChr, 1).Text = " " [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Dic.Item(c) = oChr
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] oChr
        c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
        [COLOR="Navy"]If[/COLOR] Dic.Item(K) - temp > NumCount [COLOR="Navy"]Then[/COLOR]
                temp = IIf(temp = 0, 1, temp)
                c = c + 1
                ReDim Preserve ray(c)
                ray(c) = Dn.Characters(temp, Dic.Item(K - 1) - temp).Text
                temp = Dic.Item(K - 1) + 1
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] K
    [COLOR="Navy"]If[/COLOR] Not Len(Dn) - Dic.Item(Dic.count) = 0 [COLOR="Navy"]Then[/COLOR]
        ReDim Preserve ray(c + 1)
        ray(c + 1) = Dn.Characters(Dic.Item(Dic.count) + 1, Len(Dn) - Dic.Item(Dic.count)).Text
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(ray)
        Cells(Dn.Row, n) = ray(n)
    [COLOR="Navy"]Next[/COLOR] n
        Erase ray
  [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Rick Rothstein]

Below is another macro solution you can try. The code consist of two parts, the macro you run (named "SplitSelectedText") and a function that it repeatedly calls. The function I am using originally had a different purpose... to wrap text at spaces only up to a maximum amount of characters... so I use it to do that and then apply the "Text To Columns" procedure to split each created line of text into separate columns. The WrapText function comes from my mini-blog article posted here (in case you want to see the explanation behind it)...

Wrap Text On Spaces Up To A Maximum Number Of Characters Per Line

Here is the code...

Sub SplitSelectedText()
  Dim Cell As Range
  For Each Cell In Selection
    If Len(Cell.Value) Then
      Cell.Value = WrapText(Cell.Value, 60)
      Cell.TextToColumns Cell, xlDelimited, , , False, False, False, False, True, vbLf
      Cell.WrapText = False
    End If
  Next
End Sub

Function WrapText(CellWithText As String, MaxChars) As String
  Dim Space As Long, Text As String, TextMax As String
  Text = CellWithText
  Do While Len(Text) > MaxChars
    TextMax = Left(Text, MaxChars + 1)
    If Right(TextMax, 1) = " " Then
      WrapText = WrapText & RTrim(TextMax) & vbLf
      Text = Mid(Text, MaxChars + 2)
    Else
      Space = InStrRev(TextMax, " ")
      If Space = 0 Then
        WrapText = WrapText & Left(Text, MaxChars) & vbLf
        Text = Mid(Text, MaxChars + 1)
      Else
        WrapText = WrapText & Left(TextMax, Space - 1) & vbLf
        Text = Mid(Text, Space + 1)
      End If
    End If
  Loop
  WrapText = WrapText & Text
End Function

HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (SplitSelectedText) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm).