I have a text string, in multiple cells within a column, that I want to separate, with a maximum of 50 numbers characters per line, but the separation should only take place at a space between words.
As an example, let's say the text string is this...
blue red pink floor ground purple tied office hamburger cheese book work today tomorrow yesterday
and I want to separate it to cells to the right with no more than 50 characters in any single cell. This is how the text should look using "|" to represent the next cell (or possible where a delimiter could be placed)...
blue red pink floor ground purple tied office|hamburger cheese book work today tomorrow|yesterday
What i have is not working correctly and locking up excel. Please Help!!
Example:
Code:
Option Explicit
Sub termsSplit()
Dim rngData As Range
Dim Cell As Range
Dim arrInput() As String
Dim arrOutput() As String
Dim strValue As String
Dim strTmp As String
Dim n As Long
Dim i As Long
Dim bContinue As Boolean
'// However you set your range//
Set rngData = Selection '<--- using the CodeName (better IMO), or, using the sheet's
'(tab) name---> ThisWorkbook.Worksheets("Sheet2").Range("A1")
For Each Cell In rngData.Cells
strValue = Cell.Value
If Len(strValue) > 50 Then
'// Split the words into an array, using the space as the delimeter. //
arrInput() = Split(strValue, " ")
'// Just clarity //
n = 0: i = 0
'// Outside loop //
Do While n <= UBound(arrInput)
'// Empty the string and set the flag//
strTmp = vbNullString
bContinue = True
'// Test must pass both //
Do While n <= UBound(arrInput, 1) And bContinue
'// If projected temp string length will be below 51... //
If Len(strTmp) + 1 + Len(arrInput(n)) <= 51 Then
'// ...add a space and the next word. //
strTmp = strTmp & Chr$(32) & arrInput(n)
n = n + 1
Else
'// ...else flip the flag. //
bContinue = False
End If
Loop
'// Add an element to our output array and tack our built string into it. //
i = i + 1
ReDim Preserve arrOutput(1 To i)
arrOutput(i) = Trim$(strTmp)
Loop
'// Plunk the results into a sized range //
Cell.Offset(, 1).Resize(, UBound(arrOutput, 1)).Value = arrOutput
Else
Cell.Offset(, 1).Value = Cell.Value
End If
Next
End Sub
Bookmarks