Concatenate strings from cells using WHILE/UNTIL LOOP?

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:

1. reading all the words from the column A into a range.
2. dumping the elements from the range (word) starting on B2, one by one
3. 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