Home > Back-end >  VBA Error 13 (Type Mismatch) when trying to add items to Collection
VBA Error 13 (Type Mismatch) when trying to add items to Collection

Time:07-07

I have 2 arrays taken from two ranges containing names. I want to create a 3rd array with ONLY the names in array 1 that are not in array 2. However there's a mismatch type error when trying to add values to a collection.

This is the whole code:

Sub CrearArreglos()

'**Array2**
Dim Array2() As Variant 
Dim iCountLI As Long 
Dim iElementLI As Long 

If IsEmpty(Range("B3").Value) = True Then
      ReDim Array2(0, 0)
Else
      iCountLI = (Sheets("Sheet2").Range("B3").End(xlDown).Row) - 2
      iCountLI = (Range("B3").End(xlDown).Row) - 2 
      ReDim Array2(iCountLI) 

      For iElementLI = 1 To iCountLI 
      Array2(iElementLI - 1) = Cells(iElementLI   2, 2).Value 
      Next iElementLI
      
End If

'**Array 1:**
Dim Array1() As Variant 
Dim iElementLC As Long

Worksheets("Sheet1").Activate
Array1 = Worksheets("Sheet1").Range("BD4:BD10").Value 

Dim v3 As Variant
Dim coll As Collection
Dim i As Long

'**Extracting values from Array 1 that are not contained in Array 2**
Set coll = New Collection

For i = LBound(Array1, 1) To UBound(Array1, 1)
    If Array1(i, 1) <> 0 Then
'**This line below displays error 13 ↓
    coll.Add Array1(i, 1), Array1(i, 1)
    End If
Next i

For i = LBound(Array2, 1) To UBound(Array2, 1)
    On Error Resume Next
    coll.Add Array2(i, 1), Array2(i, 1) 
    If Err.Number <> 0 Then
        coll.Remove Array2(i, 1)
    End If
    If coll.exists(Array2(i, 1)) Then
        coll.Remove Array2(i, 1)
    End If
    On Error GoTo 0
Next i


ReDim v3(0 To (coll.Count) - 1)

'Adds collection items to a new array:
For i = LBound(v3) To UBound(v3)
    v3(i) = coll(i   1) 
    Debug.Print v3(i)
Next i

So this is the line where error 13 is displayed. If I remove the second "Array1(i, 1)", it runs fine but it only saves all values from Array1 and it seems to ignore the rest of the code and the conditions)

coll.Add Array1(i, 1), Array1(i, 1)

Oddly enough, this code has always worked perfectly in the past when having both ranges in the same sheet. This time I'm taking the ranges from different sheets. I don´t know if that's the issue, although it doesn't make sense for me.

I'd appreciate any help. Thank you in advance!

CodePudding user response:

This should do the same thing as you intend, and with good performance:

Sub CrearArreglos()

    Dim Array1, col As New Collection, i As Long, rng2 As Range, arrOut, v
    
    With Sheets("Sheet2")
        Set rng2 = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp))
    End With
    
    Array1 = Worksheets("Sheet1").Range("BD4:BD10").Value
    
    For i = 1 To UBound(Array1, 1)
        v = Array1(i, 1)
        If Len(v) > 0 Then 'anything to check?
            'this check is faster against a range...
            If IsError(Application.Match(v, rng2, 0)) Then col.Add v
        End If
    Next i
    
    ReDim arrOut(0 To col.Count - 1)
    For i = 1 To col.Count
        arrOut(i - 1) = col(i)
    Next i
    
End Sub
  • Related