Re: Help speed up seatrch
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.
Code:
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"
Re: Help speed up seatrch
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.
Re: Help speed up seatrch
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
Re: Help speed up seatrch
You might be better off posting your functional 7 minute code so that it can be reviewed and possibly optimized.
Re: Help speed up seatrch
Here is that code:
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
Re: Help speed up seatrch
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.
Code:
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
Re: Help speed up seatrch
Quote:
Originally Posted by
MartinLiss
Here is that code:
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
Code:
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
Re: Help speed up seatrch
The range rng3 is a combination of the 3 columns, so I'm not doing 3 lookups per row.
Re: Help speed up seatrch
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
Re: Help speed up seatrch
Thanks Zvoni, but the data is in Excel and I don't have access to that data on the web.
Re: Help speed up seatrch
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
Re: Help speed up seatrch
Thank you for doing that.