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