Search each cell in range for match in an array

[spidaman]

Can anyone help find a fast solution for finding an Instr match for each cell in a range from an array please?

The code below indicates what I'm trying to do, but I know it currently won't search against each value in myArray.

myArray = UKP.Worksheets("lookup").Range("A1:A30").Value

If frmTest.RmBox.Value = True Then
        For Each cel In Hyprange
              If InStr(cel.Value, myArray) > 0 Then
                cel.EntireRow.Delete
              End If
        Next
End If

How can I adjust the Instr formula to search against each value in the array?

Any advice on improvement for the look-up speed also very welcome.

Many thanks in advance.

 

[JLGWhiz]

See if this will do it

Dim i As Long
myArray = UKP.Worksheets("lookup").Range("A1:A30").Value

If frmTest.RmBox.Value = True Then
        For Each cel In Hyprange
            For i = LBound(myArray) To UBound(myArray)
              If InStr(cel.Value, myArray(i)) > 0 Then
                cel.EntireRow.Delete
                Exit For
             End If
           Next
       Next
End If

 

[spidaman]

See if this will do it

Dim i As Long
myArray = UKP.Worksheets("lookup").Range("A1:A30").Value

If frmTest.RmBox.Value = True Then
        For Each cel In Hyprange
            For i = LBound(myArray) To UBound(myArray)
              If InStr(cel.Value, myArray(i)) > 0 Then
                cel.EntireRow.Delete
                Exit For
             End If
           Next
       Next
End If

Thanks for your help JLGWhiz. This was exactly what I was looking for, much appreciated. Unfortunately I now have a subscript out of range error on line:

If InStr(cel.Value, myArray(i)) > 0 Then

I think it's because I am using ActiveSheet reference for my Hyprange (not shown in my code example) and the active sheet shifts to the UKP.Worksheets("lookup") for MyArray.

Do you think that's a possible error reason?

 

[JLGWhiz]

The array has to load for the i variable to pull out the values. Otherwise, it produces a null string and throws the error. When you get the error message, hover the mouse pointer over the UBound(myArray) statement and see the intellisense displays a value greater than zero. If Not, then your array did not load.

 

[spidaman]

Yes I checked the intellisense indicator and is showing correct upper bound value of 30 - so MyArray seems to be loading OK.

Is it possible the error is being triggered because of what I mentioned above. The Hyprange refers to ActiveWorksheet:

    LastRow2 = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Set Hyprange = ActiveSheet.Range("B6:B" & LastRow2)

Whilst MyArray is on a sheet in a separate workbook (an Add-In sheet):

Set UKP = Workbooks("MyWorkbook.xlam")
myArray = UKP.Worksheets("lookup").Range("A1:A30").Value

I'm wondering if the UKP sheet becomes the ActiveSheet in the For Each statement making the Hyprange go out of range?

 

[Fluff]

Because the array is a 2D array you need to use

If InStr(cel.Value, myArray(i, 1)) > 0 Then

 

[JLGWhiz]

Because the array is a 2D array you need to use

If InStr(cel.Value, myArray(i, 1)) > 0 Then

good catch @Fluff, I missed that one. TX, JLG

 

[spidaman]

Because the array is a 2D array you need to use

If InStr(cel.Value, myArray(i, 1)) > 0 Then

Thanks Fluff yes that fixes the error.

However @JLGWhiz / @Fluff the loop doesn't delete all rows that contain matches within Hyprange to values in the array. If I run it several times it eventually removes the rows, but I need it to delete every row in one run if the cel in Hyprange matches a value in the array.

Any thoughts?

 

[Fluff]

How about

Dim i As Long
Dim Rng As Range
myArray = UKP.Worksheets("lookup").Range("A1:A30").Value

If frmTest.RmBox.Value = True Then
        For Each cel In Hyprange
            For i = LBound(myArray) To UBound(myArray)
              If InStr(cel.Value, myArray(i, 1)) > 0 Then
                If Rng Is Nothing Then Set Rng = cel Else Set Rng = Union(Rng, cel)
             End If
           Next
       Next
End If
If Not Rng Is Nothing Then Rng.EntireRow.Delete

 

[spidaman]

How about

Dim i As Long
Dim Rng As Range
myArray = UKP.Worksheets("lookup").Range("A1:A30").Value

If frmTest.RmBox.Value = True Then
        For Each cel In Hyprange
            For i = LBound(myArray) To UBound(myArray)
              If InStr(cel.Value, myArray(i, 1)) > 0 Then
                If Rng Is Nothing Then Set Rng = cel Else Set Rng = Union(Rng, cel)
             End If
           Next
       Next
End If
If Not Rng Is Nothing Then Rng.EntireRow.Delete

Thank you Fluff, works perfectly.

Am I correct in thinking that using Union method here creates a range of all the rows with matches to values in the array, allowing deletion altogether?

What I don't understand is why you can't just set Rng without:

If Rng Is Nothing

I don't really understand how Rng is working here......?