after the matched cell, search in the succeeding rows for a value with specific string and return the value

Question

May I ask how to search in the succeeding rows after matched cell, for a value with specific string and return the value along with the first matched cell

here is the sample of my code

Sub test()
x = 1
For Line = 2 To Range("B" & Rows.Count).End(xlUp).Row

    If InStr(1, Range("B" & Line), "Main") <> 0 And InStr(1, Range("B" & Line), "Sub") <> 0 Then
    x = x + 1
    Range("F" & x) = Range("B" & Line)
    Range("E" & x) = Range("A" & Line)
    Range("G" & x) = Range("B" & Line).
    End If
Next

End Sub

I'm having problem returning the value at column G that is related to the match at column E and F

here is the sample of what should the code must do

Answer 1

Try this code:

Option Explicit
Sub SubDataExtraction()
    
    'Declarations.
    Dim DblIndex As Double
    Dim VarResult() As Variant
    Dim RngResult As Range
    Dim RngCell As Range
    Dim RngData As Range
    Dim StrSearchWord01 As String
    Dim StrSearchWord02 As String
    Dim StrSearchWord03 As String
    
    'Settings.
    Set RngData = Range(Range("B2"), Range("B" & Range("B" & Rows.Count).End(xlUp).Row))
    Set RngResult = Range("E2")
    StrSearchWord01 = "Main"
    StrSearchWord02 = "Sub"
    StrSearchWord03 = "animal"
    ReDim VarResult(1 To RngData.Rows.Count, 1 To 3)
    
    'Covering each cell of RngData.
    For Each RngCell In RngData
        
        'Checking if RngCell contains both StrSearchWord01 and StrSearchWord02.
        If InStr(1, RngCell.Value2, StrSearchWord01) <> 0 And InStr(1, RngCell.Value2, StrSearchWord02) <> 0 Then
            
            'Setting DblIndex for the next row of results.
            DblIndex = DblIndex + 1
            
            'Reporting the values in VarResult (column 1 and 2).
            VarResult(DblIndex, 1) = RngCell.Offset(0, -1).Value2
            VarResult(DblIndex, 2) = RngCell.Value2
            
        End If
        
        'Checking if RngCell contains StrSearchWord03 and if VarResult hasn't already a value in the first and third column.
        If InStr(1, RngCell.Value2, StrSearchWord03) <> 0 And _
           VarResult(Excel.WorksheetFunction.Max(DblIndex, 1), 3) = "" And _
           VarResult(Excel.WorksheetFunction.Max(DblIndex, 1), 1) <> "" _
           Then
            
            'Reporting the value in VarResult (column 3).
            VarResult(DblIndex, 3) = RngCell.Value2
            
        End If
        
    Next
    
    'Reporting the result in RngResult properly expanded.
    RngResult.Resize(DblIndex, UBound(VarResult, 2)).Value2 = VarResult
    
End Sub