Search a range and display matches in a new column with VBA

Question

I'm trying to write something up that will search a specific range for specific numbers.

EX:

Dim cell As Range
For Each cell In Range("E5:E112")
If InStr(cell.Value, "260") > 0 Then
DO THIS
ElseIf InStr(cell.Value, "154") > 0 Then
DO THIS
etc...

I used instr since the cell will have things like "word 1 word 2 260 word 3."

For every match it finds within that range, I want to put a certain value into the same row in a different column.

Suggestions? Thanks in advance!

Answer 1

Try This:

Sub testing()
    Dim cell As Range
    For Each cell In Range("E5:E112")
        If InStr(cell.Value, "260") > 0 Then
            cell.Offset(0, 2).Value = "Found 260"
        ElseIf InStr(cell.Value, "154") > 0 Then
            cell.Offset(0, 2).Value = "Found 154"
        End If
    Next
End Sub

Answer 2

create an array of the items you want to look up then loop that with a built in lookup function.

Then use the row number returned to find the value you want. It will be quicker

Dim lkupArr()
lkupArr = Array(260, 154)

Dim i As Long
For i = LBound(lkupArr) To UBound(lkupArr)
    Dim lkuprow As Long
    lkuprow = 0
    On Error Resume Next
        lkuprow = Application.WorksheetFunction.Match("*" & lkupArr(i) & "*", ActiveSheet.Range("E:E"), 0)
    On Error GoTo 0
    If lkuprow > 0 Then
        MsgBox lkupArr(i) & " found on row " & lkuprow & "."
        'Then just use the return to return the value from the column you want
        'The following returns the value in column F on the same row.
        Dim ret
        ret = ActiveSheet.Cells(lkuprow, "F").Value
        Debug.Print ret
    End If
Next i

Answer 3

Maybe not the most elegant solution, however does not make extensive use of the spreadsheet, so performance wise (if you have a lot of data to process), should be better than other solutions so far.

Function SearchAndFind()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rngValues As Range
    Dim arrRng As Variant, arrFind As Variant
    Dim i As Long, j As Long, newColOffset As Long

    'Adjust as needed
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    Set rngValues = ws.Range("E5:E112")
    arrRng = rngValues
    arrFind = Array("260", "154")
    newColOffset = 2


    For i = LBound(arrRng) To UBound(arrRng)                'loop through the given range, first column only
        For j = LBound(arrFind) To UBound(arrFind)          'loop through items to find
            If InStr(arrRng(i, 1), arrFind(j)) > 0 Then     'found the value
                'Return the values
                rngValues.Cells(1, 1).Offset(i - 1, newColOffset).Value = arrRng(i, 1)
                Exit For
            End If
        Next j
    Next i

End Function