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:

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!

CodePudding user response：

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:

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