Splitting maximum 30 characters, whole name.

[sbe42]

Hi all,

I have 4 columns with names inside. I need to make sure the all the columns has a maximum of 30 characters only. I would need whole names inside. It cant be cut off half way. Column one does not change if it has less than 30 characters.

Scenario 1

If the first column has 20 characters inside, 2nd column has 20 characters and 3rd column has 20 characters. It should remain this way.

Scenario 2.

If the first column has 31 characters inside, 2nd column has 15 characters and 3rd column has 15 characters.
The last word of the first column should shift over to the 2nd column. And continue from there. leaving the 3rd column as it is.

Scenario 3

If the first column has 40 characters, 2nd column has 30 characters and 3rd column has 15 characters.
The first column should be at a max of 30 characters. The remainder will be pushed to the start of the 2nd column combining with the original data from the 2nd column. And the now if the 2nd column has more than 30 characters it will push over to the 3rd column.


Example,

A1
1. John Smith Bohdie Alam Shah mane
2. Poer Poemn John
3. Peter Russel

B2
2. As owner and changi hosptial champ
3. Champ

C3
2. Jeremieh


I would need it to look like below.


A1
1. John Smith Bohdie Alam Shah
2. Poer Poemn John
3. Peter Russel

B2
1. Mane
2. As owner and changi hosptial
3. Champ

C3

2. champ Jeremieh


The cells are next to each other. Hence A1,B1,C1
I used the numbering to make it easier to note which row it comes from.


Thank you!!!! for the help. If u guys could provide formulas or codes i would be so grateful. Using excel 2013.

 

[Rick Rothstein]

First off, your example is not very clear, but your description is, so I think I know what you want to do. However, I have a question that I don't think you covered. For Row 1, what if cell A1 has 15 characters in it and cell B1 has 10 characters in it... do you want it left as is or do you want all of the text to be in cell A1 and cell B1 blank after the macro runs? In other words, do you want to maximize the amount of text in each cell if possible?

 

[sbe42]

Hi Rick,

If cell a1 has 15 characters and b1 has 10 characters, it should be left the way it is.
if cell a1 has 15 characters and b1 has 32 characters, only cell b1 should move 2 characters to cell c1.

Whole name is a must though. The names should not be cut off.

Sorry about my bad example. thank you so much for the help.

 

[Rick Rothstein]

Hi Rick,

If cell a1 has 15 characters and b1 has 10 characters, it should be left the way it is.
if cell a1 has 15 characters and b1 has 32 characters, only cell b1 should move 2 characters to cell c1.

Whole name is a must though. The names should not be cut off.

See if this macro does what you want (given that the macro is overwriting your original data, make sure to test it on a copy of your worksheet until you are sure it is doing what you want)...

Sub Max30PerCell()
  Dim R As Long, C As Long, Space As Long
  Dim TextMax As String, Text As String, Excess As String
  Dim Data As Variant
  Const MaxChars As Long = 30
  Data = Range("A1").CurrentRegion.EntireRow
  For R = 1 To UBound(Data, 1)
    Excess = ""
    For C = 1 To UBound(Data, 2)
      Text = Trim(Excess & " " & Data(R, C))
      If Len(Text) = 0 Then
        Exit For
      ElseIf Len(Text) >= MaxChars Then
        TextMax = Left(Text, MaxChars + 1)
        If Right(TextMax, 1) = " " Then
          Data(R, C) = Trim(TextMax)
          Excess = Mid(Text, TextMax + 1)
        Else
          Space = InStrRev(TextMax, " ")
          If Space = 0 Then
            Data(R, C) = Left(Text, MaxChars)
            Excess = ""
          Else
            Data(R, C) = Left(TextMax, Space - 1) & vbLf
            Excess = Mid(Text, Space + 1)
          End If
        End If
      Else
        Data(R, C) = Text
        Excess = ""
      End If
    Next
  Next
  Application.ScreenUpdating = False
  With Range("A1").Resize(UBound(Data, 1), UBound(Data, 2))
    .Value = Data
    .ClearFormats
  End With
  Application.ScreenUpdating = True
End Sub

 

[sbe42]

Hi Rick,

When using your formula the error happened at variant. Not quite sure how your formula works. But have a look at this.

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub test()
lr = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lr
mystring = Trim(Range("A" & i))
mylen = Len(mystring)
If mylen > 30 Then
For x = mylen To 1 Step -1
If Mid(mystring, x, 1) = " " And x < 30 Then
mystr = Left(mystring, x)
mystr2 = Right(mystring, mylen - x)
Range("B" & i) = mystr2 & " " & Range("B" & i)
Range("A" & i) = mystr
Exit For
End If
Next
End If
mystring = Trim(Range("B" & i))
mylen = Len(mystring)
If mylen > 30 Then
For x = mylen To 1 Step -1
If Mid(mystring, x, 1) = " " And x < 30 Then
mystr = Left(mystring, x)
mystr2 = Right(mystring, mylen - x)
Range("C" & i) = mystr2 & " " & Range("C" & i)
Range("B" & i) = mystr
Exit For
End If
Next
End If
Next
End Sub</code>
Ill be using this formula. Unfortunately it ends at range C. i am trying to extend it to range E. But i keep getting an error.

 

[Rick Rothstein]

Hi Rick,

When using your formula the error happened at variant.

That does not tell me anything useful... you need to describe the error to us.

Is the text that the code is creating incorrect in some way? If so, in what way is it wrong.

Or are you getting an error message displayed to you? If so, tell us what the error number and description are.

What would be real useful is if you can post a copy of your worksheet contain the original text (before any code is run on it) that does not work so that I can debug the code live against actual data instead of the data I made up when I tested the code while writing it. You can post a copy of the workbook using dropbox or some other free file sharing web facility.