Splitting a cell based on character count,

[g8rfn]

Hi everyone,

I have a whole bunch of cells with super long strings of text. What I need is a macro or some automated way to split each long cell into multiple cells that have a MAXIMUM of only 40 characters each. Also, when it splits the characters, I don't want it to chop off the words either. Is this even possible in Excel? So, for example, my first cell in the list has 197 characters, so I would need that split into 5 cells, or possibly even 6 depending on how close to 40 it could split each string into.

My mind is going numb... If there weren't 1800 of these, I would jsut do it manually... Heck, I may have even been done by now if I wasn't still trying to figure out how to do it "easily."

 

[StevenD]

Hi,

I have assumed a couple of things to get a "working" example.

OK I've assumed your strings are in Column A listed Down.
I have made it split the code in column A into lengths of 40 across the columns on the same row i.e String in A1 is split into 1st 40 characters into B1, next 40 into C1 etc.

I will point of the parts in the code to change to suit your data.

You will need to put a commandbutton on your spreadsheet.

Private Sub CommandButton1_Click()
Call SplitString
End Sub

Sub SplitString()
Dim myrange As String
myendrow = ActiveSheet.Range("a65536").End(xlUp).Row ' Change the "a65536" to ur column i.e "b65536"
For a = 1 To myendrow
    myrange = ActiveSheet.Range("a" & a) ' CHANGE "A" to  ur column.
    StringLength = Len(myrange)
    NumberOfCellsToSplit = Round(StringLength / 40, 0)
    StartOfSplit = 1
    For b = 2 To NumberOfCellsToSplit + 2
        If StringLength - StartOfSplit >= 40 Then
           LengthOfCode = 40
        Else
            LengthOfCode = StringLength + 1 - StartOfSplit
        End If
        Cells(a, b) = Mid(myrange, StartOfSplit, LengthOfCode)
        StartOfSplit = StartOfSplit + LengthOfCode
    Next b
Next a
End Sub

Make sure you save a copy of your spreadsheet first!!!

HTH

 

[g8rfn]

Thanks so much!

But, how would I make it list them vertically in a column instead of across the row? Ultimately, these strings will need to be imported into an SQL DB, and the data will all need to be in one column.

 

[StevenD]

Can you tell me how your data is setup?

I.e where the strings are and where you want the split up strings put (Which Columns or Rows)

 

[g8rfn]

Also, this still truncates the strings regardless of whether or not it's in the middle of a word or not. Is there any way to check this, and force it back to the last space before truncating?

 

[g8rfn]

All of my long strings are listed in column A. So, in a perfect world... I'd like A1 to be cut into B1 - B? (However many rows are needed), then a 1 row space, then A2 split into next X B rows... etc.

If it's easier, you could set it to break A1 into the B column, A2 into C, A3 into D, etc. Then I could copy and paste them all back into one row. The main time saver for me is cutting them up.

 

[StevenD]

Sorry didn't realise you wanted that function as well, I will have a look

 

[StevenD]

OK this should be nearly there hopefully.

Remember to save your book just in case.

Sub SplitString()
Dim myrange As String
myendrow = ActiveSheet.Range("a65536").End(xlUp).Row
myendrow2 = ActiveSheet.Range("b65536").End(xlUp).Row
For a = 1 To myendrow
    myrange = ActiveSheet.Range("a" & a) ' CHANGE "A" to  ur column.
    StringLength = Len(myrange)
    NumberOfCellsToSplit = Round(StringLength / 40, 0)
    StartOfSplit = 1
    For b = 2 To NumberOfCellsToSplit + 2
        If StringLength - StartOfSplit >= 40 Then
           LengthOfCode = 41
            If Mid(myrange, LengthOfCode, 1) <> " " Then
                Do Until Mid(myrange, LengthOfCode, 1) = " "
                LengthOfCode = LengthOfCode - 1
            Loop
            End If
        Else
            LengthOfCode = StringLength + 1 - StartOfSplit
        End If
        Cells(myendrow2, 2) = Mid(myrange, StartOfSplit, LengthOfCode)
        StartOfSplit = StartOfSplit + LengthOfCode
    myendrow2 = myendrow2 + 1
    Next b
    myendrow2 = myendrow2 + 1
Next a
End Sub

 

[Scott Huish]

Perhaps:

Sub splitup40()
Dim c As Range, z As String, tmp As String, j As Long, k As Integer
k = -1
For Each c In Range("A1", Range("A65536").End(xlUp))
    z = c
    Do
        tmp = Left(z, 40)
        j = 40
        If Right(tmp, 1) <> " " And Mid(z, 41, 1) <> " " And Right(tmp, 1) <> "." And Right(tmp, 1) <> "," Then j = InStrRev(tmp, " ")
        tmp = Left(tmp, j)
        If tmp <> "" Then Range("B65536").End(xlUp).Offset(1 + k, 0) = tmp
        k = 0
        z = Trim(Mid(z, j + 1))
    Loop Until tmp = ""
    k = 1
Next
End Sub

 

[g8rfn]

There is still some slight wacky-ness with some of them... But, I can't seem to narrow down what the problem is. In any event, I'd say about 60-75% of them look correct.

Thanks again. This has saved me a TON of time.