Fastest VBA search for each instance (unsorted data across mult columns)?

A faster search as my FindAll function for your special case (one column search) is my MatchAll function, but if you plan to use a loop to check the adjoining cell values, your process will slow down much much more as FindAll need to find all the cells. :-)

IMHO the fastest way for this is to read all data into an array and search the values in there. Even with 9 columns and 10.000 rows in each, I guess this will be so fast that you did not notice that the macro was executed.

But if you want to select all prices <= 1 we have to combine the found positions (the referring cells), this need some time. 

UNION slows down as more cells are in that range, but we can use a trick and use a dictionary and an algorithm to make it much more faster, see my function FastUnion below.

How long does it need to execute?

Andreas.

Option Explicit

#Const ShowTimings = True

#If ShowTimings Then

'The QueryPerformanceFrequency function retrieves the frequency of the high-resolution _

  performance counter, if one exists.

Private Declare Function QueryPerformanceFrequency Lib "kernel32" (cyFrequency As Currency) As Long

'The QueryPerformanceCounter function retrieves the current value of the high-resolution _

  performance counter, if one exists.

Private Declare Function QueryPerformanceCounter Lib "kernel32" (cyTickCount As Currency) As Long

Private Function MilliTimer() As Double

  'return containing seconds uses Windows API calls to the high resolution timer

  Dim Ticks As Currency

  Static Frequency As Currency

  MilliTimer = 0

  ' get frequency

  If Frequency = 0 Then

    QueryPerformanceFrequency Frequency

    If Frequency = 0 Then Exit Function

  End If

  ' get ticks

  QueryPerformanceCounter Ticks

  ' calc seconds

  MilliTimer = Ticks / Frequency

End Function

#End If

Sub FindApples()

  Dim Data()

  Dim i As Long, j As Long

  Dim All As Range

#If ShowTimings Then

  Dim dtime As Double

  dtime = MilliTimer

#End If

  'Read all data into an array

  Data = Range("A1").CurrentRegion

  'Visit all columns, 3 columns are 1 dataset

  For j = 1 To UBound(Data, 2) Step 3

    'Visit each row

    For i = 1 To UBound(Data)

      'Compare the values

      If StrComp(Data(i, j), "Apples", vbTextCompare) = 0 Then

        If Data(i, j + 1) <= 1 Then

          'Remember the refering cell

          FastUnion All, Cells(i, j + 1)

        End If

      End If

    Next

  Next

  'Build a range from all found cells

  Set All = FastUnion(All)

#If ShowTimings Then

  dtime = (MilliTimer - dtime)

  Debug.Print "FindApples:  " & Format(dtime, "0.000000") & " seconds"

#End If

  If All Is Nothing Then

    Debug.Print "Nothing found"

  Else

    All.Select

    Debug.Print All.Count & " cells.Found"

  End If

End Sub

Private Function FastUnion(ByRef All As Range, Optional ByRef R As Range = Nothing) As Range

  '© Andreas Killer, 2011

  Static Stack As Object 'Dictionary

  Dim Temp() As Variant

  Dim i As Long, j As Long

  'Initialize our internal stack if necessary

  If Stack Is Nothing Then Set Stack = CreateObject("Scripting.Dictionary")

  'Should we return the result?

  If R Is Nothing Then

    'Did we have something?

    If Stack.Count = 0 Then

      Set FastUnion = All

      Exit Function

    End If

    'Get all cells as fragments

    Temp = Stack.Items

    'Combine each fragment with the next one

    j = 1

    Do

      For i = 0 To UBound(Temp) - j Step j * 2

        Set Temp(i) = Union(Temp(i), Temp(i + j))

      Next

      j = j * 2

    Loop Until j > UBound(Temp)

    'At this point we have all cells in the first fragment

    'Combine with the previous result from the outside if any

    If All Is Nothing Then

      Set FastUnion = Temp(0)

    Else

      Set FastUnion = Union(All, Temp(0))

    End If

    'Remove all items from the stack

    Stack.RemoveAll

  Else

    'Add the range to our internal stack

    Stack.Add Stack.Count, R

  End If

End Function

You might consider using autofilter:

Sub GetApples()

Dim i As Long, xlCell As Range, lRow As Long

With ActiveSheet

  lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row

  .Rows("1:1").AutoFilter

  For i = 1 To 7 Step 3

    With .Columns(i)

      .AutoFilter Field:=i, Criteria1:="Apples"

      For Each xlCell In .Range(Columns(2).Rows(2), Columns(2).Rows(lRow)).SpecialCells(xlCellTypeVisible)

        If xlCell.Value <= 1 Then MsgBox xlCell.Value & vbTab & xlCell.Offset(0, 1).Value

      Next

      .AutoFilter Field:=i

    End With

  Next

  .Rows("1:1").AutoFilter

End With

End Sub