Error in For Each loop using AutoFilter runtime (error 13)

Question

This is what I am trying to do

1. Find unique values in column D
2. Loop over those values by creating a filter with each
3. with the remaining rows after filtering, I do the same with columns E and F.
4. Finally, I just need to copy the remaining values in column K and past them in a different sheet.

In one of the loops the code gives me an error (see line below). I have tried to solve it in different ways and looked for an answer online, but I have not been able to find why is that happening. I got "run-time error '13' Type mismatch"

I highly appreciate any ideas. Thanks!!

Sub UniqueVals_f()

'' Variables
Dim i As Variant   ' loop counter
Dim a As Variant   ' loop counter
Dim R As Long
Dim W As Long
Dim Z As Long
Dim gr As Variant  ' group values
Dim ca As Variant  ' category value
Dim cl As Variant  ' class value
Dim CategArray() As Variant
Dim GroupArray() As Variant
Dim ClassArray() As Variant
Dim My_Range As Range
Dim DestSh As Worksheet ' Destination sheet
Dim LastCol As Long
Dim rng As Range
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range


' select range
Set My_Range = Worksheets("ICP").Range("D1", Range("F" & Rows.Count).End(xlUp))
My_Range.Parent.Select
My_Range.Parent.AutoFilterMode = False  'Remove the AutoFilter

' Destination sheet
Set DestSh = Sheets("items")

ca = Application.Transpose(Range("D2", Range("D" & Rows.Count).End(xlUp))) ' extract Categories
With CreateObject("Scripting.Dictionary") 'Categories array
    For Each i In ca  ' <-- This one works fine
        .Item(i) = i
    Next
    CategArray = Application.Transpose(.Keys)  ' getting unique values
End With

'' loop over categories
For R = 1 To UBound(CategArray, 1)
    My_Range.AutoFilter Field:=1, Criteria1:="=" & CategArray(R, 1) ' First Filter
    gr = Application.Transpose(Range("E2", Range("E" & Rows.Count).End(xlUp))) ' extract Groups
    With CreateObject("Scripting.Dictionary")
        For Each i In gr  ' <-- This one works fine too
            .Item(i) = i
        Next
        GroupArray = Application.Transpose(.Keys) ' getting unique values
    End With

    '' Loop over Groups
    For W = 1 To UBound(GroupArray, 1)
        My_Range.AutoFilter Field:=2, Criteria1:="=" & GroupArray(W, 1) ' Second Filter

        lr3 = Cells(Rows.Count, 6).End(xlUp).Row   '' Extract Classes
        cl = Application.Transpose(Range("F2:F" & lr3))
        ' cl = Range("F2:F" & lr3)               ' Alternative way 1
        ' cl = Range("F2:F" & lr3).Value2        ' Alternative way 2
        With CreateObject("Scripting.Dictionary")
            For Each i In cl    '' <-- THE ERROR IS HERE!!!
            'For i = LBound(cl, 1) To UBound(cl, 1) ' Alternative that has the same error
                .Item(i) = i
            Next
            'Next i
            ClassArray = Application.Transpose(.Keys)
        End With

        '' Loop over classes
        For Z = 1 To UBound(ClassArray, 1)
            ' filter classes
            My_Range.AutoFilter Field:=3, Criteria1:="=" & ClassArray(Z, 1) ' Third Filter

            '' Copy items
            Set rng = DestSh.Rows("2:2")
            LastCol = Last(2, rng)

            Range("K2", Range("K" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
            Destination:=DestSh.Cells(2, LastCol + 1)

            My_Range.Parent.AutoFilterMode = False  'Remove the AutoFilter

        Next Z
    Next W
Next R

End Sub

Best, Pablo

Answer 1

All your alternatives won't work if lr3 = 2, because Range("F2:F" & lr3).Value (.Value is invoked implicitly since you dont use Set) will NOT be an array but just a value, and the same applies for its Transpose.

The reason is that you are not using Set, so you are getting a value, and the value of a single cell will not be an array. I noticed that none of your Transpose operations is necessary. So try this quick-fix,

• Remove all your Transpose statements and take the original range

• use the Set keyword to have range objects instead of arrays

.

 Set ca = Range("D2", Range("D" & Rows.Count).End(xlUp))

 Set gr = Range("E2", Range("E" & Rows.Count).End(xlUp))

 Set cl = Range("F2:F" & lr3)

That said, this will fix only the issue at hand. There are many other problems in the code. One of them being that when you apply My_Range.Parent.AutoFilterMode = False, All filters are removed, not only the one applied in the inner loop. But try fixing the current issue at the moment.