Subscript out of range error looping through rows and columns in Excel VBA

Question

I want to loop through rows and columns in VBA.

I have a table of recipes for ceramic glazes:

Not all recipes have the same amount of ingredients.
These recipes aren't real.

I want to generate a list of recipes with the title of the recipe followed by the ingredients and the amount of each ingredient:

I modified a code snippet found here:

Sub ExtractRecipes()

    Dim wsSrc As Worksheet: Set wsSrc = Worksheets("cone6")
    Dim wsDest As Worksheet: Set wsDest = Worksheets("output")
    Dim LastRow As Long: LastRow = wsSrc.UsedRange.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
    Dim LastCol As Long: LastCol = wsSrc.UsedRange.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Dim i As Long, j As Long, RowCounter As Long: RowCounter = 1
    On Error Resume Next

    With wsDest
        For i = 1 To LastRow
            .Cells(RowCounter, 1) = wsSrc.ListObjects("testTable").ListColumns("recipe").DataBodyRange.Cells(i)
            For j = 1 To LastCol
                If wsSrc.ListObjects("testTable").DataBodyRange.Cells(i, j) <> "" Then
                    .Cells(RowCounter + 1, 1) = wsSrc.ListObjects("testTable").ListColumns("material_" & j).DataBodyRange.Cells(i)
                    .Cells(RowCounter + 1, 2) = wsSrc.ListObjects("testTable").ListColumns("material_amount_" & j).DataBodyRange.Cells(i)
                    .Cells(RowCounter + 1, 3) = Err.Description
                    RowCounter = RowCounter + 1
                End If
            Next j
        Next i
    End With

End Sub

I get an error

subscript out of range

Current output:

Answer 1

Untested but something like this should work:

Sub ExtractRecipes()

    Dim wsSrc As Worksheet, wsDest As Worksheet, lo As ListObject, col As Long
    Dim RowCounter As Long, rw As Range, rec, mat, amt
    
    Set wsSrc = Worksheets("cone6")
    Set lo = wsSrc.ListObjects("testTable")
    
    Set wsDest = Worksheets("output")
    RowCounter = 1
    
    For Each rw In lo.DataBodyRange.Rows   'loop rows in listobject
        rec = rw.Cells(1).Value            'recipe
        If Len(rec) > 0 Then               'have entry?
            wsDest.Cells(RowCounter, 1).Value = rec
            For col = 2 To lo.ListColumns.Count Step 2
                mat = rw.Cells(col).Value
                amt = rw.Cells(col + 1).Value
                If Len(mat) > 0 Then '+ test amount?
                    RowCounter = RowCounter + 1
                    wsDest.Cells(RowCounter, 1).Resize(1, 2).Value = Array(mat, amt)
                End If
            Next col
            RowCounter = RowCounter + 1 'add empty row between
        End If
    Next rw
End Sub