Is it possible to use InStr() combined with Application.Vlookup()?

user_7475225 0
Viewed 622

I currently have a With statement that will compare the value of a cell to a range of cells and InStr() returns true then mark cell.Value as "Yes" and if not then "No".

Here is the scenario. Say I am checking the value of A2 and this is 111. I am comparing 111 to a range of other cells and the field that should match is 111, 222, 333 as it contains 111 in it. My first set of code below works for this but is slow. I was hoping for a faster way and I think I can do this with a formula but using True instead of False in the vlookup is not working as I thought it would.

Here is the code:

With inv_twcg_ws
    For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
        For Each cellx In report_rng
            If InStr(cellx.Value, cell.Value) Then
                cell.Offset(0, 6).Value = "Yes"
                Exit For
            End If
                cell.Offset(0, 6).Value = "No"
        Next cellx
    Next cell
End With

The problem is it is kinda slow. My application takes about 5 min to run. I was hoping to combine InStr() with Application.Vlookup() somehow to try and speed up the formula. Is this possible?

Here is my current Vlookup but using True does not seam to be working for my needs...

With inv_twcg_ws
    For Each cell In .Range("G2:G" & .Cells(Rows.Count, "A").End(xlUp).Row)
        cell.Value = Application.WorksheetFunction.IfError(Application.VLookup(CStr(cell.Value), report_rng, 1, True), "No")
    Next cell
End With
vlookup formula vba excel
1 Answers

Use variant arrays:

Dim report_ws As Worksheet
Set report_ws = report_wb.Worksheets(1)

Dim report_rng As Variant
report_rng = report_ws.Range("B2:B" & last_row)

Dim inv_twcg_ws As Worksheet
Set inv_twcg_ws = Worksheets("Sheet1") ' change to your sheet




With inv_twcg_ws
    Dim lkup_rng As Variant
    lkup_rng = .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Value

    Dim otpt As Variant
    ReDim otpt(1 To UBound(lkup_rng, 1), 1 To 1) As Variant

    Dim i As Long
    For i = LBound(lkup_rng, 1) To UBound(lkup_rng, 1)
        otpt(i,1) = "No"
        Dim j As Long
        For j = LBound(report_rng, 1) To UBound(report_rng, 1)
            If InStr(report_rng(j, 1), lkup_rng(i, 1)) Then
                otpt(i,1) = "Yes"
                Exit For
            End If
        Next j
    Next i

    .Range("G2").Resize(UBound(otpt, 1)).Value = otpt
End With
user_48515900
Related