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:

Can you remove the On Error Resume Next and see what line is failing. At a guess it's the j variable goes to 8 but your labeling scheme goes to 4, so there is no material_7 for instance. — Warcupine
– Warcupine, Commented Mar 21, 2024 at 14:53
Besides, the error is not cleared, so once it appears, it stays until the end. — MGonet
– MGonet, Commented Mar 21, 2024 at 15:01
@Warcupine sure, the line that's failing is at .Cells(RowCounter + 1, 1) = wsSrc.ListObjects("testTable").ListColumns("material_" & j).DataBodyRange.Cells(i) — nnavaille
– nnavaille, Commented Mar 21, 2024 at 15:09

Tim Williams · Accepted Answer · 2024-03-21 15:41:48Z

2

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

answered Mar 21, 2024 at 15:41

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

nnavaille Over a year ago

Works perfectly! Thank you so much :) I'm guessing what's happening here is there's a step to count how many columns have a value?

Tim Williams Over a year ago

Yes - If Len(mat) > 0 checks to see if there's any material entered in that column.

Collectives™ on Stack Overflow

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

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related