Combine the subsequent cells strings until the next cell contains a “:”

[gwsampso]

Hello,

Could I please have some help to combine the subsequent cells strings until the next cell contains a “:” or while the subsequent cell doesn’t contain a “:”

Im trying to combine multiple cells from a column into 1 cell after 2 cases are meet

The first case is that it finds “Issue Options” and brings across is value – this works

The part which is what I need help with is that I need it to combine the subsequent cells strings until the next cell contains a “:” or while the subsequent cell doesn’t contain a “:”

Unfortunetly i cant just say bring across this cell and the next one down as their can be 2,3,4,5, ect options

Could someone please help? I’ve never used “Do While” or “Do Until”

Example Sheet Instring and Do While.xlsm (this is an extract)

Working Code for first part

Public Function FindIssueOptions(LetterText As Range) As String
    Dim LetterCell As Range
    For Each LetterCell In LetterText
        If InStr(1, LetterCell.Value, ":") > 0 Then
            Dim variableName As String
            variableName = Trim(Left(LetterCell.Value, InStr(1, LetterCell.Value, ":") - 1))
            Select Case variableName
            Case "ISSUE OPTIONS"
                FindIssueOptions = Trim(LetterCell.Value)
                Case Else
                 ' DO NOTHING
            End Select
        End If
    Next LetterCell
End Function

[nilem]

Hi Gwsampso
try it

Sub ertert()
Dim r As Range, s$, adr$, i&
i = 1
With ActiveSheet.UsedRange.Columns(1)
    Set r = .Find("ISSUE OPTIONS")
    If Not r Is Nothing Then
        adr = r.Address
        Do
            Do
                If Len(Trim(r(i, 1))) Then s = s & ", " & Trim(r(i, 1))
                i = i + 1
            Loop While InStr(r(i, 1), ":") = 0
            r(1, 2).Value = Mid(s, 3)
            s = vbNullString: i = 1
            Set r = .FindNext(r)
        Loop While r.Address <> adr
    End If
End With
End Sub

[gwsampso]

outstanding

what is "s$, adr$, i&"? please

[nilem]

Dim i&, j%, s$, d#, n!, c@

is the same as

Dim i As Long, j As Integer, s As String, d As Double, n As Single, c As Currency

[:) Sixthsense :)]

Or

Public Function FindIssueOptions(LetterText As Range) As String
Dim LetterCell As Range, variableName As String, rMyRng As Range

For Each LetterCell In LetterText
    If InStr(1, LetterCell.Value, ":") Then
        variableName = Trim(Left(LetterCell.Value, InStr(1, LetterCell.Value, ":") - 1))
        
        If variableName = "ISSUE OPTIONS" Then
            FindIssueOptions = FindIssueOptions & Trim(LetterCell.Value) & ", "
            Set rMyRng = LetterCell.Offset(1, 0)

            Do While InStr(1, rMyRng.Value, ":") = 0
                FindIssueOptions = FindIssueOptions & Trim(LetterCell.Offset(1, 0).Value) & ", "
                Set rMyRng = rMyRng.Offset(1, 0)
            Loop
            
        End If
        
        variableName = ""
        Set rMyRng = Nothing
    End If

Next LetterCell

If InStr(1, FindIssueOptions, ",") > 0 Then FindIssueOptions = Left(FindIssueOptions, Len(FindIssueOptions) - 2)

End Function

[gwsampso]

great work all thanks you