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("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