Search for all values between 2 values in a column and loop till last one found

Question

Lets start with I am self taught in Excel VBA and have a question that might seem stupid or basic:

I have the following information on a sheet:

[ConfBlastPlan]

DRB1065

PU1962;427;05_37_OB;A;2;2;1

PU1963;364;05_37_OB;B;2;2;1

PU1959;373;05_37_OB;C;2;2;1

- [FiringProcedure]11:55:21;MULTI

What I want to do is combine all strings between with "PU" and the first ";" that is found between the "[ConfBlastPlan]" and [FiringProcedure] into one cell.

I have read up about the loop function but seems I have confused myself terribly.

How do I loop this and combine the strings found?

I have started the function using the following code:

Sub DRBEquipNumberPU() 'GET THE PU#s

Dim WSFrom As Worksheet
Dim WSTo As Worksheet

Dim RngFrom As Range
Dim RngTo As Range

Dim BlastNumber As String
Dim BlastNumberStep As Long

Dim SearchString As String
Dim SearchStringStart As String
Dim SearchStringEnd As String

Dim LineStep As Long

Dim Blastedrng As Range
Dim BlastedFoundrng As Range

Dim closePos As Integer

BlastNumberStep = 1
LineStep = 1

Set Blastedrng = ThisWorkbook.Worksheets("Blast Summary Sheet").Range("A2", Range("A2").End(xlDown))

For Each BlastedFoundrng In Blastedrng.Cells

    On Error Resume Next

    SearchString = "[ConfBlastPlan]"
    SearchStringStart = "PU"
    SearchStringEnd = "[FiringProcedure]"
    
    BlastNumber = CStr("Blasted " & BlastNumberStep)

    Set WSFrom = Worksheets(CStr(BlastNumber))
    Set RngFrom = WSFrom.Cells.Find(What:=SearchString, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
             
    Set RngFrom1 = WSFrom.Cells.Find(What:=SearchStringStart, After:=RngFrom, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                    
    Set WSTo = ThisWorkbook.Worksheets("Blast Summary Sheet")
    Set RngTo = WSTo.Cells.Find(What:=(CStr(BlastNumber)), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                          
    closePos = InStr(1, RngFrom.Cells.Value, ";")
                                  
    If RngTo.Cells.Offset(0, 4).Value = "INCOMPLT" Then
    
        RngTo.Cells.Offset(0, 7).Value = "INCOMPLT"
    
    ElseIf RngFrom.Cells.Value Is Nothing Then
    
        RngTo.Cells.Offset(0, 7).Value = "NO PU #s"
        
    ElseIf RngFrom.Cells.Value Like SearchStringStart Then
    
        RngTo.Cells.Offset(0, 7).Value = Mid(RngFrom.Cells.Value, 0, closePos)
        
    ElseIf RngFrom.Cells.Value = SearchStringEnd Then
             
    End If
    
    BlastNumberStep = BlastNumberStep + 1

Next BlastedFoundrng
End Sub

All it returns at the moment is INCOMPL or NO PU #s

There can be a maximum of 48 instances of PU

Please help

Blasted 23:

Blasted 26:

Blasted 27:

Answer 1

Option Explicit

' Major changes: make it two steps-- 1)Get all Sheet names, 2)Process all Lines on one sheet

Sub StepThruBlastedSheetNames() 'GET THE PU#s

    Dim WSSummary As Worksheet, rowSummary As Long
    Set WSSummary = ThisWorkbook.Worksheets("Blast Summary Sheet")
    rowSummary = 1

    Dim WSFrom As Worksheet

    For Each WSFrom In ThisWorkbook.Worksheets
    
        If InStr(WSFrom.Name, "Blasted ") > 0 Then
            StepThruBlastedLines WSSummary, rowSummary, WSFrom
        End If
        
    Next
    
End Sub



Sub StepThruBlastedLines(WSSummary As Worksheet, rowSummary As Long, WSFrom As Worksheet)

    ' these never change, ergo do not put inside loop
    Const SearchStringStart As String = "[ConfBlastPlan]"
    Const SearchStringFindPU As String = "PU"
    Const SearchStringEnd As String = "[FiringProcedure]"

    Dim rowFrom As Long
    Dim rowMax As Long
    rowMax = WSFrom.Cells(WSFrom.Rows.Count, "A").End(xlUp).Row
    Dim IsBetween As String, PUlist As String, posSemi As Long, DRBname As String
    IsBetween = "N"
    PUlist = ""
    DRBname = ""
    
    For rowFrom = 1 To rowMax

        If IsBetween = "Y" Then
            If InStr(WSFrom.Cells(rowFrom, "A"), "DRB") > 0 Then
                DRBname = WSFrom.Cells(rowFrom, "A")
            End If
            If InStr(WSFrom.Cells(rowFrom, "A"), SearchStringFindPU) > 0 Then
                posSemi = InStr(WSFrom.Cells(rowFrom, "A"), ";")
                PUlist = PUlist & Mid(WSFrom.Cells(rowFrom, "A"), 1, posSemi)
            End If
            If InStr(WSFrom.Cells(rowFrom, "A"), SearchStringEnd) > 0 Then
                IsBetween = "N"
                    rowSummary = rowSummary + 1
                    WSSummary.Cells(rowSummary, "A") = WSFrom.Name
                    WSSummary.Cells(rowSummary, "B") = DRBname
                If PUlist <> "" Then
                    WSSummary.Cells(rowSummary, "C") = PUlist
                    PUlist = ""
                Else
                    '<< add put empty notice
                    WSSummary.Cells(rowSummary, "C") = "INCOMPL"
                End If
                DRBname = ""  '<<added
            End If
        ElseIf WSFrom.Cells(rowFrom, "A") = SearchStringStart Then
            IsBetween = "Y"
        End If
            
    Next rowFrom
        
End Sub

Answer 2

Here's code that extracts the PU-values from a worksheet like the one you posted. I couldn't figure out why you called this worksheet WsTo and perhaps that's the reason why I also couldn't guess at your intention for what to do with the result. Your question is mute on the point. So I left the project at that point. I'm sure you will be able to pick it up from the two ways I'm displaying the Output array.

Sub DRBEquipNumberPU()
  ' 134
  ' Get the PU#s

    Const Blast             As String = "[ConfBlastPlan]"
    Const BlastEnd          As String = "-"
    Const Marker            As String = "PU"
    
    Dim WsTo                As Worksheet
    Dim BlastFound          As Range
    Dim CellVal             As String               ' loop variable: Cell.Value
    Dim R                   As Long                 ' loop counter: rows
    Dim Output              As Variant              ' array of found values
    Dim i                   As Long                 ' index to Output
    
    Set WsTo = ThisWorkbook.Worksheets("Blast Summary Sheet")
    With WsTo.Columns(1)
        Set BlastFound = .Find(What:=Blast, _
                               LookIn:=xlValues, _
                               Lookat:=xlWhole, _
                               MatchCase:=False)
        If BlastFound Is Nothing Then
            MsgBox """" & Blast & """ wasn't found.", _
                   vbInformation, "No data to process"
        Else
            ReDim Output(1 To 100)                  ' choose UBound larger than you ever need
            R = BlastFound.Row
            Do
                R = R + 1
                CellVal = .Cells(R).Value
                If InStr(1, Trim(CellVal), Marker, vbTextCompare) = 1 Then
                    i = i + 1
                    Output(i) = CellVal
                End If
            Loop While Len(CellVal) And CellVal <> BlastEnd
            
            If i Then
                ReDim Preserve Output(1 To i)
                MsgBox "Found values = " & vbCr & _
                       Join(Output, Chr(13))
                For i = LBound(Output) To UBound(Output)
                    Debug.Print Output(i)
                Next i
            End If
        End If
    End With
End Sub

It just occurs to me that the end marker you suggested ("FiringProcedure]") may be more reliable than my choice ("-"). If so, just change it at the top of the code where the constants are declared. If that marker is missed the code might continue to include the "PU" line below the [Blasting Plan] row.