1 Attachment(s)
VBA Macro: Text Split by defined # of characters - word dropping issue
Hello.
I have the following macro to split a string into 35 char. sections without breaking full words. It functions but for some reason drops the last 10 characters "(50452770)" of the original string as well as other random ending words like "Charger" from row 12 in the attached sample data;
Code:
Sub DescBreakTextA35()
'' Cycles through all rows in column D putting a pipe every 35 characters without breaking whole words
For i = 2 To Range("D" & Rows.Count).End(xlUp).Row 'Sets the range to cycle through
Cells(i, 4).Activate 'Selects the cell to be split. i is the row, 4 is the column
Dim str_Out As String 'Variable to hold the new text string as it is created
Dim iloop As Integer 'Used as a counter for how many words are in the current string
Dim strString As Variant 'The original string will be split into an array and placed in this holder
Dim num As Integer 'Holds the max number of characters allowed
str_Out = "" 'Set empty value to put the new text in
num = 35 'Set the max number of characters. This number will increase each time it adds a new delimiter
strString = Split(ActiveCell.Value, " ") 'Splits the text into an array
For iloop = LBound(strString) To UBound(strString) 'Sets the number of cycles that the For Loop runs based on how many elements(words) are in the array
If iloop < UBound(strString) Then 'If the count of iloop is less then the max number of words, then keep running this loop
str_Out = str_Out & strString(iloop) & " " 'Takes the current string of text, adds the next word in the array, and a Space to separate it from the next word
If (Len(str_Out) + Len(strString(iloop + 1))) > num Then
str_Out = str_Out & "|" 'If the length of the current string plus the length of the next word of the string is greater then the text limit, then don't add the next word and add a pipe instead
num = Len(str_Out) + 35 'Count the current length of the text and add 35 to it
End If
End If
Next
str_Out = Trim(str_Out) 'Trim any extra whitespace off the text string
ActiveCell.Value = str_Out 'output the edited text string into the cell that the original text was in
Range("D:D").Replace What:=" |", Replacement:="|"
Next
'' Split Column D with Text to Column using Piping as delimiter
Range("D2:D65000").Select
Selection.TextToColumns Destination:=Range("E2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
Range("D:D").Replace What:="|", Replacement:=" "
End Sub
Could this be an issue with the actual split function?
Thank you!
