Concatenate strings from cells using WHILE/UNTIL LOOP? - excel

Question

I have strings stored in cells of a column in Excel that I would like to concatenate in several pieces, like sentences, with VBA. Here is an example:
Column A
Jack
learns
VBA
Jack
sits
on
a
couch
Jack
wants
chocolate
cake
I finally found a way to concatenate all strings and save the sentences to a cell:
Sub JACK()
Dim MP() As String
Dim Str As String
Dim i As Integer
For i = 2 To 10
ReDim Preserve MP(i)
MP(i) = Cells(i, 1).Value
Next i
Str = Join(MP)
Cells(1, 2).Value = Str
End Sub
But I would like to have the sentences that start with "Jack" and end with the row "Jack - 1", each saved in seperate cells.
Could anyone help me???
Thank you so much!

Answer 1

This is the code snippet that will do what you want:
Sub test_func()
' this is the starting cell (keep in mind that the first word in the cell is 'Jack' so the start cell is actually starting at C2)
Dim startCell As range
Set startCell = ThisWorkbook.ActiveSheet.range("B2")
' reading all the cells in the range
Dim wordRange As range
Set wordRange = ThisWorkbook.ActiveSheet.range("A2:A13")
' creating two variables row and col
Dim row As Long
Dim col As Long
' for each word in wordRange
Dim word As Variant
For Each word In wordRange
' as soon as we find the word 'Jack'
If word.Value = "Jack" Then
' move the cursor to row 0
row = 0
' move the cursor one cell to the right
col = col + 1
End If
' else if the word is not 'Jack', put the word on the cursor cell
startCell.Offset(row, col) = word
' then move the cursor one cell down
row = row + 1
Next
End Sub
The function is:
reading all the words from the column A into a range.
dumping the elements from the range (word) starting on B2, one by one
as soon as it finds the word 'Jack', it will start at row 0, move to the right and continue
The outcome looks like this:
This is the output of the script
Note that the words are starting on C2 even though you chose B2 to be the starting cell; this is because the first word in the list is 'Jack', so it is moving one cell to the right as soon as it starts.
EDIT:
Here might be the function that you are looking for:
Sub test_func()
' this is the starting cell (keep in mind that the first word in the cell is 'Jack' so the start cell is actually starting at C2)
Dim startCell As range
Set startCell = ThisWorkbook.ActiveSheet.range("B2")
' reading all the cells in the range
Dim wordRange As range
Set wordRange = ThisWorkbook.ActiveSheet.range("A2:A13")
' creating two variables row and col
Dim row As Long
Dim col As Long
' string that holds each sentence
Dim sentence As String
' for each word in wordRange
Dim word As Variant
For Each word In wordRange
' as soon as we find the word 'Jack' and the sentence is not empty, the sentence is complete
If word.Value = "Jack" And sentence <> "" Then
'printing out the whole sentence
startCell.Offset(row, col) = sentence
' emptying the sentence when 'Jack' is found
sentence = ""
' move the cursor one cell down
row = row + 1
End If
' else if the word is not 'Jack', concatenates the word into the sentence
sentence = sentence & " " & word
Next
' adding this again at the end of the loop because the last sentence is not outputted otherwise
startCell.Offset(row, col) = sentence
End Sub
This function differs from the previous one because it concatenates the words into a sentence before dumping it out. In this function, the start cell is correct and is not moving down or right when the program starts. This is because we can check whether the sentence that it is about to dump out is empty or not, if it is; then it means we did not finish our sentence.
Hope this helps!
This is the result screenshot of the second version of the code

Answer 2

Extract Sentences From Column
Sub JACK()
Const JackStart As String = "Jack"
Const JackEnd As String = "."
Const Delimiter As String = " "
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim slCell As Range: Set slCell = ws.Cells(ws.Rows.Count, "A").End(xlUp)
Dim srg As Range: Set srg = ws.Range("A2", slCell)
Dim dCell As Range: Set dCell = ws.Range("B2")
Dim sCell As Range
Dim JackString As String
Dim FoundFirst As Boolean
For Each sCell In srg.Cells
If sCell.Value = JackStart Then
If FoundFirst Then
dCell.Value = JackString & JackEnd
Set dCell = dCell.Offset(1) ' next row
Else
FoundFirst = True
End If
JackString = JackStart
Else
If FoundFirst Then JackString = JackString & Delimiter & sCell.Value
End If
Next sCell
dCell.Value = JackString & JackEnd
MsgBox "Jacks extracted.", vbInformation
End Sub