Extract certain rows from a cell with value “Start” to “Finish”

My current code is giving the result in different columns and is only limited by the rows declared for checking. Seeking help to improve the code to be have the result in one column as seen in sample picture.

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
    
    
    
    'Settings.
    Set RngData = Range(Range("A2"), Range("B" & Range("A" & Rows.Count).End(xlUp).Row))
    Set RngResult = Range("L10")
    StrSearchWord01 = "Start"
    StrSearchWord02 = "Finish"
    
    
    
    
    ReDim VarResult(1 To RngData.Rows.Count, 1 To 50)
    
    '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 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(4).Value2
            VarResult(DblIndex, 2) = RngCell.Offset(5).Value2
                        
                  
       End If
       
      
    Next
    
    'Reporting the result in RngResult properly expanded.
    RngResult.Resize(DblIndex, UBound(VarResult, 2)).Value2 = VarResult



Set rng = Range("L2:S100")
Application.ScreenUpdating = False
With rng
    .Value = Evaluate(Replace("If(@="""","""",Trim(@))", "@", .Address))
End With
Application.ScreenUpdating = True


    
End Sub