Excel vba alternatives to "find" to reduce runtime

Question

The code is supposed to find strings in column A of a worksheet , if cde is found, copy and paste it into the "new" worksheet, if cde not found, continue to find efg and if efg found, copy and paste into the "new" worksheet.

May i ask for advices or opinions on how i can use functions other than .find to reduce the runtime?

Dim LongRow As Long
LongRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row + 1

'Find efg if not hij if not klm
Set c = wksData.Columns("A:A").Find("efg ", LookIn:=xlValues)

If Not c Is Nothing Then
    wks.Cells(LongRow, 9).Value = c.Value
Else
    Set f = wksData.Columns("A:A").Find("hij", LookIn:=xlValues)
    If Not f Is Nothing Then
        wks.Cells(LongRow, 9).Value = f.Value
    Else
        Set g = wksData.Columns("A:A").Find("klm", LookIn:=xlValues)
        If Not g Is Nothing Then
            wks.Cells(LongRow, 9).Value = g.Value
        End If
    End If
End If         

Answer 1

For exact match, Match is very fast, but for 3 items you're not going to notice the difference

Dim m, v

For Each v in Array("efg","hij","klm")
    m = Application.Match(v, wksData.Columns("A:A"), 0)
    If Not IsError(m) Then
        wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1, 0).Value = _
                    wksData.Cells(m, 1).Value 
        Exit For
    End If
Next v

If you're not looking for exact match you can use

m = Application.Match(v & "*", wksData.Columns("A:A"), 0)       'look for "begins with v"
m = Application.Match("*" & v & "*", wksData.Columns("A:A"), 0) 'look for "contains v"

Answer 2

Here is a short code that will search the column only 1x for all your searched sub-strings and should be faster, Try ...

    Sub SearchColumn()

    Dim ws1 As Worksheet, ws2 As Worksheet

    Dim ws1Row As Integer, ws2Row As Integer
    Dim ws1Col As Integer, ws2Col As Integer
    Dim ws1RowMax As Integer

    Dim searchedText(2) As String
    Dim cellText As String

    searchedText(0) = "efg"
    searchedText(1) = "hij"
    searchedText(2) = "klm"

    Set ws1 = Worksheets(1)
    Set ws2 = Worksheets(2)

    ws1Row = 1
    ws1Col = 1 '-- col A, 2 = col B, etc.

    ws2Row = 1
    ws2Col = 1 '-- col A, 2 = col B, etc.

    ws1RowMax = 100 '-- choose a number (can be max - 65000
                    ' or program for last cell.
                    ' There is a protection in the For loop -
                    '  - if a cell is empty, routine will quit

    With ws1
        For ws1Row = 1 To ws1RowMax
            cellText = .Cells(ws1Row, ws1Col)
            If (cellText = "") Then Exit For
            check = CheckMatch(cellText, searchedText)
            If (check) Then
                ws2.Cells(ws2Row, ws2Col) = cellText
                ws2Row = ws2Row + 1
            End If
            ws1Row = ws1Row + 1
            If (ws1Row > ws1RowMax) Then Exit For
        Next ws1Row
    End With

End Sub

Function CheckMatch(textToCheck As String, searchedText() As String) As Boolean
    Dim result As Boolean
    For Each txt In searchedText
        If (InStr(textToCheck, txt)) Then
            result = True
            Exit For
        End If
    Next
    CheckMatch = result
End Function

For this to run as is, make sure you have at least 2 sheets in your workbook. In 1st sheet place your text data in column 1 - or change the number of 'ws1Col' to the number of the column where your text is. You may also need to adjust the starting row in the For loop from 1 to any number where your text search starts. Hope this helps.

Answer 3

There are a few ways that you could speed this up. A simple one might be to create a custom sort order for your items, sort your data in that order, and then simply take the first row of data.

Skeleton code would look a bit like this:

Const FIRST_DATA_ROW As Long = 2

Dim wksData As Worksheet, wks As Worksheet
Dim tempRng As Range, sortRng As Range
Dim searchItems As Variant, item As Variant
Dim lastCol As Long, lastRow As Long, rowCount As Long, n As Long
Dim output() As Long
Dim found As Boolean

'HOUSEKEEPING FIRST.
'-------------------
'Define your sheets as required.
Set wksData = ThisWorkbook.Worksheets("Sheet1")
Set wks = ThisWorkbook.Worksheets("Sheet2")

'Define data limits.
With wksData
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

'Create a temp column to store original sort order.
rowCount = lastRow - FIRST_DATA_ROW + 1
ReDim output(1 To rowCount, 1 To 1)
For n = 1 To rowCount
    output(n, 1) = n
Next
Set tempRng = wksData.Cells(FIRST_DATA_ROW, lastCol + 1).Resize(rowCount)
tempRng.Value = output

'SORT THE DATA.
'--------------
'Define the search items in order.
searchItems = Array( _
    "efg", _
    "hij", _
    "klm")

Application.AddCustomList searchItems

'Execute the sort.
With wksData
    Set sortRng = .Range( _
        .Cells(FIRST_DATA_ROW, "A"), _
        .Cells(lastRow, lastCol + 1))
End With

With wksData.Sort
    With .SortFields
        .Clear
        .Add _
            Key:=sortRng.Columns("A"), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            CustomOrder:=Join(searchItems, ","), _
            DataOption:=xlSortNormal
    End With
    .SetRange sortRng
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'DATA TRANSFER
'-------------

'Check if first item is in the search list.
For Each item In searchItems
    If item = wksData.Cells(FIRST_DATA_ROW, "A").Value2 Then
        found = True
        Exit For
    End If
Next

If Not found Then
    'Nothing is found.
    MsgBox "No items found."
Else
    'Copy data to new sheet.
    With wks
        lastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
        .Cells(lastRow + 1, "I").Value = wksData.Cells(FIRST_DATA_ROW, "A").Value2
    End With
End If

'CLEAN UP
'--------

'Unsort data.
With wksData.Sort
    With .SortFields
        .Clear
        .Add _
            Key:=tempRng, _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
    End With
    .SetRange sortRng
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Clear the temp sort order.
tempRng.ClearContents

Another way would be to log each time you hit a match and just look for higher priority items. Once you've reached a top priority item, then end the search. Again, skeleton code could be like this:

Const FIRST_DATA_ROW As Long = 2

Dim wksData As Worksheet, wks As Worksheet
Dim searchItems As Variant, data As Variant
Dim priority As Long, foundIndex As Long, i As Long, j As Long

'Define your sheets as required.
Set wksData = ThisWorkbook.Worksheets("Sheet1")
Set wks = ThisWorkbook.Worksheets("Sheet2")

'Define the search items in order.
searchItems = Array( _
    "efg", _
    "hij", _
    "klm")

'Read the data into an array.
With wksData
    data = .Range( _
                .Cells(FIRST_DATA_ROW, "A"), _
                .Cells(.Rows.Count, "A").End(xlUp)) _
            .Value2
End With

'Loop through the data.
priority = -1
foundIndex = -1
For i = 1 To UBound(data, 1)
    'Look for a match.
    For j = 0 To UBound(searchItems)
        If data(i, 1) = searchItems(j) Then
            'We have a match, so ...
            'Store the values.
            foundIndex = i
            priority = j
            'Remove lower priority search items.
            If priority > 0 Then ReDim Preserve searchItems(j - 1)
            Exit For
        End If
    Next
    'Stop if we have a top priority match.
    If priority = 0 Then Exit For
Next

'Copy the data.
If foundIndex = -1 Then
    'Nothing is found.
    MsgBox "No items found."
Else
    'Copy data to new sheet.
    With wks
        .Cells(.Rows.Count, "I").End(xlUp).Offset(1).Value = data(foundIndex, 1)
    End With
End If