VBA- Retrieving data from an access database by referencing a column in excel

Question

I am not able to run the for loop when number of rows exceed 8-9k. Can you suggest an alternate method for this? can you suggest the syntax to referencing the data using a tablename(or column name) instead of looping over the cells one by one?

Sub ddd()
Const dbloc As String = "C:\Users\system1\Downloads\Database11.accdb"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim xlbook As Workbook
Dim xlsheet As Worksheet
Dim a As Long
Dim SQL As String


Set xlbook = ActiveWorkbook
Set xlsheet = xlbook.Worksheets(1)
xlsheet.Range("B2:Z100000").ClearContents


Set db = OpenDatabase(dbloc)

SQL = "SELECT Material, MPN  "
SQL = SQL & "FROM Sheet2 "

  SQL = SQL & "WHERE Material IN ("
  Dim r As Range
  For Each r In Range("A2:A6768")
   SQL = SQL & r.Text & ","
  Next r
  SQL = Left(SQL, Len(SQL) - 1) 'Drop last comma
  SQL = SQL & ")"



Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
If rs.RecordCount = 0 Then
MsgBox "No data retrieved from database", vbInformation + vbOKOnly, "No         
 Data"
    GoTo SubExit
Else
    rs.MoveLast
    recCount = rs.RecordCount
    rs.MoveFirst
End If
 xlsheet.Range("C2").CopyFromRecordset rs

End Sub

Answer 1

I would suggest that instead of building such a large WHERE clause dynamically, and running into the 64K character limitation of a query's text, that you create a table and insert into it the data from Excel. Your SQL then becomes:

SELECT Sheet2.Material, Sheet2.MPN
FROM Sheet2 
INNER JOIN TempSelection
  ON Sheet2.Material = TempSelection.Material

which will work with large amount of selection.

To achieve this, you should create the table TempSelection in Access - it only needs one column, Material of the same data type as the Sheet2 table (is that a linked table to Excel or an actual Access table that was imported from Excel? If imported, good; otherwise, I encourage you to import data instead).

Then your For...Next loop would now look similar to this...

db.Execute "DELETE FROM TempSelection;", dbFailOnError
Set rsTemp = db.OpenRecordset("TempSelection", dbOpenDynaset)
For Each r In Range("A2:A6768")
  rsTemp.AddNew
  rsTemp.Fields("Material").Value = r.Value2 'Or, r.Value if needed
  rsTemp.Update
Next r

Answer 2

For review, ignoring the excessive SQL selection, I would observe that your code is quite likely to create a spreadsheet of misaligned and partial data. Any values requested for retrieval which don't actually exist in the database or are in a different order than the spreadsheet will be set against a different identifier, potentially wrecking any association with the values in the A column.

If that association is not important, I would suggest that the records should be put into a different tab (or different workbook altogether).

If the association with the A column is wanted, you could retrieve the records singly, although of course that would take more time. The gaps of nonexistent records would be apparent, if that might be useful.

You can achieve the sheet clearing action you seem to want at the start of the process - preserving first row and first column - more generally with xlsheet.UsedRange.Offset(1,1).ClearContents