Sleeper: Look up records in Access from Excel and copy data to cell

[DWinter]

Hi there,

I have a very large list of data (more than Excel (14) can hold) in Access (14).
I want to use Excel to search this data using a cell value in a range of cells and bring back corresponding values, then loop to the next cell in the range and repeat.

I have "bolted" together this code (I am no expert) which calls a database connection, selects the range values one by one and gets the recordset. Problem is that I only ever get the first record in the Access table in my spreadsheet, the others return nothing.

PCP_Asset_List_Test = Access table name
UserID = 1st field in Access Table (which matches Excel value)
User Name = 2nd field in Access table (value to be returned to Excel)



Sub ListOfPeople()
Dim sqlstr As String
sqlstr = "SELECT * FROM PCP_Asset_List_Test"
Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")
Call connectDatabase
rs.Open sqlstr, DBCONT
If rs.RecordCount > 0 Then
On Error Resume Next
For Each ce In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set rs = db.OpenRecordset("SELECT [PCP_Asset_List_Test].[User Name]" & _
"FROM [PCP_Asset_List_Test] WHERE [UserID] = '" & ce.Value & "'")
ce.Offset(0, 1).Value = rs.Fields("User Name").Value
Set ce = Nothing
Set rs = Nothing
Next ce
Else
MsgBox "No Records Found"
End If
rs.Close
Set rs = Nothing
Call closeDatabase
End Sub

Can anyone help me with this ?

[mancubus]

welcome to vbax.

please use code tags when posting your code. (Copt code here. Select it. Click # button.)

assuming Column B is blank and you have checked required references in VBE, Tools, References, try:




Sub vbax_55089_Retrieve_Column_From_Access_Table()

Dim cnt As New ADODB.Connection, rst As New ADODB.Recordset
Dim DBaseName As String, Crit As String

Crit = "(" & Join(Application.Transpose(Range("A1").CurrentRegion.Value), ",") & ")"
DBaseName = "C:\MyFolder\MySubFolder\MyAccDB.accdb" 'change Path and DB name to süit

cnt.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & DBaseName & ";"
rst.Open "SELECT [User Name] FROM [PCP_Asset_List_Test] WHERE [UserID] IN " & Crit, cnt

Range("B1").CopyFromRecordset rst

End Sub