Best way to find specific text in a text field and assign a value

[thechazm]

Good Morning Everyone,

I am looking for some opinions on the fastest way to locate text within a text field and assign a value if specific text is matched.

So here is the scenario:

Lets say you need to locate the word WPV, NVM, and WKZ in everyrecord between a certain date and time.

So what I currently do is setup an array as a reference table with the ID for each of those words and have it go through each record checking for those letters. If it finds one then it saves the ID of that word to the current record.

So if the reference array looks like this:

1-WPV
2-NVM
3-WKZ

And it was looking at the following data:

1/21/2013 - 001WPV49085 <---- This would save the ID of 1 into a field in that record
1/21/2013 - 002NVM30948 <---- This would be 2.
1/21/2013 - 00304WKZ987 <---- This would be 3.


I currently have written a function to do this but my problem is I don't have to much processing power so it takes a long time maxing out one of the cores during the whole process.

Here is my written function:

Function ExtractProjects()
On Error GoTo ErrHandler:
Dim db As Database, rs As DAO.Recordset, rs2 As DAO.Recordset, var() As Variant, i As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("Select [ID], [SDSK] from [Project Name Ref] WHERE((([SDSK]) Is Not Null))", dbOpenSnapshot)
rs.MoveLast
rs.MoveFirst
ReDim var(rs.RecordCount, 2)
i = 0
Do While rs.EOF = False
    var(i, 0) = rs("SDSK")
    var(i, 1) = rs("ID")
    i = i + 1
    rs.MoveNext
Loop
rs.Close
Set rs = db.OpenRecordset("Select * from [(SDSK) Charges Master] WHERE((([IBB Date]) Between #" & GetChargesStart & "# AND #" & GetChargesEnd & "#) AND (([Charge Num]) Is Not Null))", dbOpenSnapshot)
Set rs2 = db.OpenRecordset("Select * from [(SDSK) Charges Master] WHERE [IBB Date] Between #" & GetChargesStart & "# AND #" & GetChargesEnd & "#", dbOpenDynaset)
rs.MoveLast
rs.MoveFirst
ii = rs.RecordCount
Do While rs.EOF = False
    StatusLabel "Find Project Reference for ST and OT Charges. On Record:" & rs.AbsolutePosition & " - " & ii
    For i = LBound(var) To UBound(var)
 
        If InStr(1, rs("Charge Num"), var(i, 0)) > 0 Then
            rs2.FindFirst "[ID] = " & rs("ID")
            If rs2.NoMatch = False Then
                With rs2
                    .Edit
                    ![PID] = var(i, 1)
                    .Update
                End With
            End If
'            With rs2
'                .Edit
'                ![PID] = var(i, 1)
'                .Update
'            End With
            Exit For
        End If
    Next i
    rs.MoveNext
Loop
StatusLabel "Completed!"
rs.Close
rs2.Close
Set rs = Nothing
Set rs2 = Nothing
Set db = Nothing
Exit Function
ErrHandler:
If Err.Number = 3052 Then
    StatusLabel "Clearing Buffer..."
    Err.Clear
    Resume
Else
    MsgBox Err.Number & " " & Err.Description
End If
rs.Close
rs2.Close
Set rs = Nothing
Set rs2 = Nothing
Set db = Nothing
End Function

My question after all that is there a faster better way of doing this type of operation than what I am already currently doing? It runs through about 50-60K of records every day.

Thanks for the help.

 

[spikepl]

1. Your algorithm checks each line for all matches, also if one match has already been found. That does not seem necessary -stop checking if a match has been found.

2. In a normal language a line like
LBound(var) To UBound(var)

would be optimized by the compiler and lookup not repeated. I believe VBA has a pretty dumb compiler, so these two values i'd put into variables once and for all at the beginning of the code and use the variables instead. This will of course only give a pittance.

3. In general, testing Boolean variabels like this:

If MyBool = False Then

is pointless, because

If MyBool Then

does the job.

So, e.g.,
Do While NOT rs.EOF
If NOT rs2.NoMatch Then

4.Good morning??? You know that the sun never sets on AWF??

 

[thechazm]

lol Gotcha Thanks for the feedback and I'll give it a go.