I have 7 source files that I am searching and cross-referencing. I have tried a few different methods inside Excel (cell-by-cell iteration, dictionary), and found select statements as recordsets to be the fastest thus far.
Unfortunately, it still takes around 5 seconds for my code to search 4 of the files for all instances of a string from another file. Since this file currently has 9,000 (and will soon grow to over half a million), I'm wondering how I can improve the speed.
The 7 files are structured as follows:
String-Source
(10+ fields, only 2 are needed, current product listing downloaded in .xlsx format from a website)- 4 vendor files (.csv or tab delimited or .xls or the like, with/without/maybe-sometimes headers, ranging in size from small [only 5,000 records] to larger [about a million] records, 20+ fields but only 3 are needed)
sheets("yes")
andsheets("no")
(3 fields each, very small less than 1000, only used when I find a match, of which I only expect less than 100,000 hits each, so I am focusing less on optimizing search here)
The purpose of my code:
I have a key value that will be identical across the source and vendor files. Unfortunately, this value might be found multiple times in my source file, and multiple times or not at all in my vendor files. This value represents a model number, unique to the manufacturer, but each vendor includes multiple manufacturers in their files.
A problem is that the manufacturer name may (often does) have a different spelling, not only from file to file, but also within vendor files. Therefore I can't just concatenate the two fields into one and search for matches. What I have been doing is finding every instance of the model number, and comparing the manufacturer name fields to see if they refer to the same company (sometimes the manufacturer is spelled out, sometimes acronym, sometimes location appended, sometimes sub-brand used instead of or in addition to manufacturer, and often just spelled wrong. Oh, and many of the manufacturers in this industry have similar names.)
This comparison is being done by hand by a human and go into my yes/no sheets, so the human only has to answer the same question one time, regardless of the number of times this report is run. So, every time the model number is identical, I search the yes/no sheets, and if 'yes' then they are the same product and the 'ID' (third field, unique by file) is output for use by a different process.
Sub matchprod2()
Application.ScreenUpdating = False
Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr As String
Set myworkbook = ThisWorkbook
Dim cn As Object: Dim thisbook As Object
Set cn = CreateObject("adodb.connection"): Set thisbook = CreateObject("adodb.connection")
strfilename = ThisWorkbook.Path
cn.connectionstring = _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strfilename & _
";Extended Properties=""text;HDR=NO;imex=1"";"
cn.Open
thisbook.connectionstring = _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
thisbook.Open
Set thisrs = thisbook.Execute("select * from [SourceProducts$a1:c9111]")
a = 1
Do Until thisrs.EOF
a = a + 1
mfg = thisrs(0)
modelnum = thisrs(2)
myworkbook.Sheets("matches").Cells(a, 1).Value = mfg
myworkbook.Sheets("matches").Cells(a, 2).Value = modelnum
Set rs1 = cn.Execute("select Field6, Field1 from invfeed.csv where Field2='" & modelnum & "'")
Set rs2 = <same as rs1, different file>
Set rs3 = <same as rs1, different file>
Set rs4 = <same as rs1, different file>
Do Until rs1.EOF
If Trim(rs1("Field6")) = Trim(mfg) Then
If myworkbook.Sheets("matches").Cells(a, 2 + 1) <> "" Then myworkbook.Sheets("matches").Cells(a, 2 + 1).Value = "multiple": Exit Do
myworkbook.Sheets("matches").Cells(a, 2 + 1) = rs1("Field1")
Else
If comparenames2(Trim(mfg), Trim(rs1("Field6")), "Vendor1", thisbook) Then myworkbook.Sheets("matches").Cells(a, 2 + 1) = "'" & rs1("Field1")
End If
rs1.movenext
Loop
Set rs1 = Nothing
Do Until rs2.EOF
<same as rs1, different file>
rs2.movenext
Loop
Set rs2 = Nothing
Do Until rs3.EOF
<same as rs1, different file>
rs3.movenext
Loop
Set rs3 = Nothing
Do Until rs4.EOF
<same as rs1, different file>
rs4.movenext
Loop
Set rs4 = Nothing
thisrs.movenext
If a Mod 50 = 0 Then Debug.Print a; Now()
Loop
Set thisrs = Nothing
cn.Close
thisbook.Close
Set cn = Nothing
Set thisbook = Nothing
Application.ScreenUpdating = True
End Sub
Public Function comparenames2(Sourcename, Manname, invfilesource, wkbkconn) As Boolean
If IsNull(Manname) Then comparenames2 = False: Exit Function
Set yeslist = wkbkconn.Execute("select [Source Manufacturer], [Vendor Manufacturer] from [yes$A:B] where [Source Manufacturer]='" & Sourcename & "'")
Do Until yeslist.EOF
If yeslist(1) = Manname Then comparenames2 = True: Exit Function
yeslist.movenext
Loop
Set nolist = wkbkconn.Execute("select [Source Manufacturer], [Vendor Manufacturer] from [no$A:B] where [Source Manufacturer]='" & Sourcename & "'")
Do Until nolist.EOF
If nolist(1) = Manname Then comparenames2 = False: Exit Function
nolist.movenext
Loop
Application.ScreenUpdating = True
result = MsgBox("Are the following Manufacturers the same?" & vbNewLine & Sourcename & vbNewLine & Manname, vbYesNo + vbQuestion + vbSystemModal)
Application.ScreenUpdating = False
If result = vbYes Then mysheetname = "yes" Else mysheetname = "no"
mylastrow = ThisWorkbook.Sheets(mysheetname).Cells.Find(what:="*", after:=ActiveSheet.Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ThisWorkbook.Sheets(mysheetname).Cells(mylastrow + 1, 1) = Sourcename
ThisWorkbook.Sheets(mysheetname).Cells(mylastrow + 1, 2) = Manname
ThisWorkbook.Sheets(mysheetname).Cells(mylastrow + 1, 3) = invfilesource
If result = vbYes Then comparenames2 = True Else comparenames2 = False
End Function