Help speed up seatrch

[MartinLiss]

I have Sheet1 with 55 thousand rows and in another worksheet I have a named range consisting of a single column containing 450 values. Since the cells in F to H may contain multiple words in a cell, currently I'm searching for partial word matches and if I find any one of the 450 values in any cell in F, G or H I put "delete" in column X. My macro as written takes 7 minutes to run. I could post my macro but what I'm looking for is an example of a very fast method that might cut the time down to less than a minute.

I found this method on-line and it claims to be the fastest way to do something like I want to do but I'm not smart enough to convert it for my situation.

'****************************************************
'Purpose: Search a range and return an array showing the row
'and column location of the target value.
'rngSearch - specify the range to search
'strTarget - specify the value to search for
'****************************************************
Function Func_Search_Range_With_MATCH( _
ByRef rngSearch As Range, _
ByVal strTarget As String _
) As Variant
    'declare variables
    Dim arrOutput As Variant 'specify output array (row found, col found)
    
    'set output array to not found as default
    ReDim arrOutput(1 To 1, 1 To 2) 'create output array
    arrOutput(1, 1) = -1 'set default to -1
    arrOutput(1, 2) = -1 'set default to -1
        
    'determine size of search range
    Dim lgRowSize As Long
    Dim lgColSize As Long
    lgRowSize = rngSearch.Rows.Count
    lgColSize = rngSearch.Columns.Count
    
    'break the search range into a "strip" of continguous cells by row or column depending which is smaller or optimise speed
    'search each strip using MATCH
    Dim rngStrip As Range 'declare a "strip" of cells
    Dim lgStripCounter As Long 'declare a "strip" counter
    Dim vntRelativeLocation As Variant 'specify the relative location of found target within the "strip"
    Dim lgAbsoluteStartLocation As Long 'absolute start column no: or row no: of a "strip"
    On Error Resume Next
    If lgColSize < lgRowSize Then 'smaller no: of columns
        'search by columns
        For lgStripCounter = 1 To lgColSize
            lgAbsoluteStartLocation = rngSearch.Columns(lgStripCounter).Cells(1, 1).Column 'determine the start location of the first cell in strip
            vntRelativeLocation = Application.WorksheetFunction.Match(strTarget, rngSearch.Columns(lgStripCounter), 0) 'search the target using MATCH in the strip
            If Err.Number = 0 Then
                'determine the results
                arrOutput(1, 1) = vntRelativeLocation + lgAbsoluteStartLocation - 1 'found row location
                arrOutput(1, 2) = lgStripCounter 'found column location
                Exit For
            Else
                Err.Clear
            End If
        Next
    Else 'smaller no: of rows or equal rows and columns
        For lgStripCounter = 1 To lgRowSize
            lgAbsoluteStartLocation = rngSearch.Rows(lgStripCounter).Cells(1, 1).Row 'determine the start location of the first cell in strip
            vntRelativeLocation = Application.WorksheetFunction.Match(strTarget, rngSearch.Rows(lgStripCounter), 0) 'search the target using MATCH in the strip
            If Err.Number = 0 Then
                'determine the results
                arrOutput(1, 1) = vntRelativeLocation + lgAbsoluteStartLocation - 1 'found row location
                arrOutput(1, 2) = vntRelativeLocation 'found column location
                Exit For
            Else
                Err.Clear
            End If
        Next
    End If
    
    'output the result
    Func_Search_Range_With_MATCH = arrOutput
End Function

[jdelano]

You could start by looping the range with the 450 possible search items. Then step through this code to see how this is working with your data.

Dim rngFourFifty as Range
Dim rngSearchArea as Range
Dim vtSearchResult as Variant
Dim strColumnXValue as String
Dim c as Range

Set rngSearchArea = ThisWorkbook.WorkSheets("Sheet1").Range("Range55K")
Set rngFourFifty = ThisWorkbook.WorkSheets("SheetContaining450").Range("Range450")

Application.ScreenUpdating = False
For each c in rngFourFifty

    vtSearchResult = Func_Search_Range_With_MATCH(rngSearchArea, c.value)
    if vtSearchResult(1,1) = -1 then
        ' not found
        strColumXValue = ""
    Else
        ' found
        strColumXValue = "Delete"
    End If
    
    Sheet1.Cells(vtSearchResult(1,1), "X") = strColumnValue 
Next c
Application.ScreenUpdating = True
MsgBox "Search Complete"

[MartinLiss]

Thanks but strColumnValue wasn't defined and when I changed it to strColumnXValue only 25 rows were marked for deletion, where about 60% should have been marked.

[MartinLiss]

Below is a link to a small(er) sample you can test with. In Module1 you'll find 3 macros:

• Test: Your code as modified by me
• PruneTradeArea: My current code
• Func_Search_Range_With_MATCH

If you look at my code you'll find that the output columns should be FF and FG. FG is only there for testing.

https://www.mediafire.com/file/c7a9s...mple.xlsb/file

[OptionBase1]

You might be better off posting your functional 7 minute code so that it can be reviewed and possibly optimized.

[MartinLiss]

Here is that code:

Sub PruneTradeArea()
Dim lngLastRow As Long
Dim lngRow As Long
Dim rngFW As Range
Dim cel As Range
Dim rng3 As Range
Dim rngFound As Range
Dim lngDeleted As Long

'Debug.Print Now
lngLastRow = Range("A1048576").End(xlUp).Row

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

For lngRow = 2 To lngLastRow
    Set rng3 = Range(Cells(lngRow, "F"), Cells(lngRow, "H"))
    
   ' Column FF is used temporarily to store the "delete" flag
    For Each cel In Range("Forbidden").Rows
        Set rngFound = rng3.Find(What:=cel, MatchCase:=False, LookAt:=xlPart)
        If Not rngFound Is Nothing Then
            Cells(lngRow, "FF") = "delete"
            lngDeleted = lngDeleted + 1
        End If
    Next
Next

Range("FF2:FF" & lngLastRow).AutoFilter Field:=1, Criteria1:="delete"
  
'delete rows that are visible
Application.DisplayAlerts = False
Range("FF2:FF" & lngLastRow).SpecialCells(xlCellTypeVisible).Delete
Columns("FF:FF").Delete
Application.DisplayAlerts = True

MsgBox lngDeleted & " rows deleted", vbInformation + vbOKOnly, "Results of Pruning"
    
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
'Debug.Print Now
End Sub

[jdelano]

Yep, sorry. I didn't change the variable on the marking of the column.

As far as the matching, perhaps it is due to case sensitivity?
I'll peek at your example.

EDIT:
Yeah, the function you quoted doesn't seem to do what you need. As I stepped through, it correctly found the term LOT (it is at row 543) but it returns the location as 105. It is obviously not there. I don't have any more time today to look at it. Sorry.

I put a stop command in the code to see where it thought that was.

Private Sub btnSearch_Click()

    btnSearch.Caption = "Searching"
    DoEvents
    
    Dim rngFourFifty As Range
    Dim rngSearchArea As Range
    Dim vtSearchResult As Variant
    Dim strColumnXValue As String
    Dim c As Range
    Dim amountFound As Integer
    Dim shtTA As Worksheet
    
    ' I created my own range names in the file I downloaded and add this search button to the TradeArea sheet   
    Set shtTA = ThisWorkbook.Worksheets("TradeArea")
    Set rngSearchArea = shtTA.Range("searchRange")
    Set rngFourFifty = ThisWorkbook.Worksheets("Forbidden Words").Range("ForbiddenWords")
    
    shtTA.Range("J:J").Clear   ' to see it easier I just used J this clears the column at start
    shtTA.Range("K:K").Clear  ' this is the term it reported it found the match at
    
    amountFound = 0
    Application.ScreenUpdating = False
    For Each c In rngFourFifty
    
        If c.Value = "LOT" Then Stop
        
        vtSearchResult = Func_Search_Range_With_MATCH(rngSearchArea, c.Value)
        If vtSearchResult(1, 1) > -1 Then
            ' found
            shtTA.Cells(vtSearchResult(1, 1), "J") = "Delete"
            shtTA.Cells(vtSearchResult(1, 1), "K") = shtTA.Cells(vtSearchResult(1, 1), "K") & c.Value
            amountFound = amountFound + 1
        End If
                
    Next c
    Application.ScreenUpdating = True
    
    btnSearch.Caption = "Search"
    DoEvents
    
    MsgBox "Search Complete, found: " & CStr(amountFound)


End Sub

[Zvoni]

Here is that code:

Sub PruneTradeArea()
Dim lngLastRow As Long
Dim lngRow As Long
Dim rngFW As Range
Dim cel As Range
Dim rng3 As Range
Dim rngFound As Range
Dim lngDeleted As Long

'Debug.Print Now
lngLastRow = Range("A1048576").End(xlUp).Row

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

For lngRow = 2 To lngLastRow
    Set rng3 = Range(Cells(lngRow, "F"), Cells(lngRow, "H"))
    
   ' Column FF is used temporarily to store the "delete" flag
    For Each cel In Range("Forbidden").Rows
        Set rngFound = rng3.Find(What:=cel, MatchCase:=False, LookAt:=xlPart)
        If Not rngFound Is Nothing Then
            Cells(lngRow, "FF") = "delete"
            lngDeleted = lngDeleted + 1
        End If
    Next
Next

Range("FF2:FF" & lngLastRow).AutoFilter Field:=1, Criteria1:="delete"
  
'delete rows that are visible
Application.DisplayAlerts = False
Range("FF2:FF" & lngLastRow).SpecialCells(xlCellTypeVisible).Delete
Columns("FF:FF").Delete
Application.DisplayAlerts = True

MsgBox lngDeleted & " rows deleted", vbInformation + vbOKOnly, "Results of Pruning"
    
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
'Debug.Print Now
End Sub

Use a "Helper"-Column (or a variable!), where you concat the Values of the 3 cells in Cols F, G and H, then it's only one lookup per row instead of three
And instead of Range.Find you can use the LIKE-operator in an If-Clause

aircode

Dim rng3 As String
For lngRow = 2 To lngLastRow
    rng3 = Cells(lngRow, "F") & Cells(lngRow, "G")) & Cells(lngRow, "H"))
'Don't remember if it's the Asteriks or the %-Sign for Wildcard
    ValueImLookingFor = "*" & ValueFromThe450 & "*"
   ' Column FF is used temporarily to store the "delete" flag
    
        If rng3 LIKE ValueImLookingFor Then
            Cells(lngRow, "FF") = "delete"
            lngDeleted = lngDeleted + 1
        End If
    Next
Next

[MartinLiss]

The range rng3 is a combination of the 3 columns, so I'm not doing 3 lookups per row.

[Zvoni]

Well, the last thing coming to mind would be to use ADO and do an SQL Query
Interested?

Keep in mind, that this would be a scenario „use LIKE with IN“

for this i would need a (stripped down) sample file

[MartinLiss]

Thanks Zvoni, but the data is in Excel and I don't have access to that data on the web.

[Zvoni]

Just did a test on a local file with your "config" (55K Rows in 3 Columns with 450 "values" you want to "wildcard" against the data)

Result: some 320 seconds, so about 5 Minutes....
Not sure if it's worth

[MartinLiss]

Thank you for doing that.