VBA code - splitting cell strings based on CHAR length

[SOShelp]

hey guys, for my job we have a bunch of account info (on separate lines) with names for each account consolidated into 1 cell (example: A1 = ANNE ARUNDEL COUNTY RETIREMENT SYSTEM).

were doing a data merge and the field in our system only fits 35 characters. we would like to split the names of these accounts (up to 35 characters) but not split the names in the middle. right now I have some VBA code that does that trick except it's putting the characters past 35 on the line below. I would like to fix it so that it just moves it to the next cell to the left. Sub splitup35() 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 = Trim(c) Do tmp = Trim(Left(z, 35)) j = 35 If Right(tmp, 1) <> " " And (Mid(z, 36, 1) <> " " And Len(z) > 35) 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

<tbody>
</tbody><colgroup><col></colgroup>

 

[SOShelp]

Re: help with VBA code - splitting cell strings based on CHAR length

I meant to say I would like the extra characters to the cell to the RIGHT not the left, thanks!

 

[Rick Rothstein]

Re: help with VBA code - splitting cell strings based on CHAR length

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub WrapTextOnSpacesWithMaxCharactersPerLine()
  Dim Text As String, TextMax As String
  Dim Space As Long, SplitText As Variant
  Dim Source As Range, CellWithText As Range
  
  Const DestinationOffset As Long = 1
  Const MaxChars As String = 35
  
  If MaxChars <= 0 Then Exit Sub
  On Error GoTo NoCellsSelected
  Set Source = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  On Error GoTo 0
  For Each CellWithText In Source
    Text = CellWithText.Value
    SplitText = ""
    Do While Len(Text) > MaxChars
      TextMax = Left(Text, MaxChars + 1)
      If Right(TextMax, 1) = " " Then
        SplitText = SplitText & RTrim(TextMax) & vbLf
        Text = Mid(Text, MaxChars + 2)
      Else
        Space = InStrRev(TextMax, " ")
        If Space = 0 Then
          SplitText = SplitText & Left(Text, MaxChars) & vbLf
          Text = Mid(Text, MaxChars + 1)
        Else
          SplitText = SplitText & Left(TextMax, Space - 1) & vbLf
          Text = Mid(Text, Space + 1)
        End If
      End If
    Loop
    SplitText = Split(SplitText & Text, vbLf)
    CellWithText.Offset(, DestinationOffset).Resize(, UBound(SplitText) + 1).Value = SplitText
  Next
  Exit Sub
NoCellsSelected:
End Sub[/td]
[/tr]
[/table]

 

[SOShelp]

Re: help with VBA code - splitting cell strings based on CHAR length

this is perfect thank you!

Give this macro a try...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub WrapTextOnSpacesWithMaxCharactersPerLine()
  Dim Text As String, TextMax As String
  Dim Space As Long, SplitText As Variant
  Dim Source As Range, CellWithText As Range
  
  Const DestinationOffset As Long = 1
  Const MaxChars As String = 35
  
  If MaxChars <= 0 Then Exit Sub
  On Error GoTo NoCellsSelected
  Set Source = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  On Error GoTo 0
  For Each CellWithText In Source
    Text = CellWithText.Value
    SplitText = ""
    Do While Len(Text) > MaxChars
      TextMax = Left(Text, MaxChars + 1)
      If Right(TextMax, 1) = " " Then
        SplitText = SplitText & RTrim(TextMax) & vbLf
        Text = Mid(Text, MaxChars + 2)
      Else
        Space = InStrRev(TextMax, " ")
        If Space = 0 Then
          SplitText = SplitText & Left(Text, MaxChars) & vbLf
          Text = Mid(Text, MaxChars + 1)
        Else
          SplitText = SplitText & Left(TextMax, Space - 1) & vbLf
          Text = Mid(Text, Space + 1)
        End If
      End If
    Loop
    SplitText = Split(SplitText & Text, vbLf)
    CellWithText.Offset(, DestinationOffset).Resize(, UBound(SplitText) + 1).Value = SplitText
  Next
  Exit Sub
NoCellsSelected:
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]