Excel VBA checking if range of values exist in ODBC connected database - vba

Question

I am having an issue (otherwise I wouldn't be here) :)
In Excel I have a list of item numbers that need to be checked if they already exist in a database. At the moment the only way to do that is to run a query in a separate sheet to get all the item numbers (400,000+) which takes quite some time and has to be done each time.
I have started a vba query which goes through each cell that is selected and checks that value to see if it exist in the database. If it exist, the cell turns Red. If it doesn't exist, the cell turns green.
I'm not that great when it comes to querying databases using VBA so I used bits and pieces that I found online.
When I go to test it, Excel crashes and closes so I can't determine where its going wrong.
Public Sub CheckItemNoExist()
Dim DB As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim c As Range
Dim ItemNum As Variant
Dim bFound As Boolean
DB.Open "DSN=DBNAME;UID=****;PWD=****;"
Set rs = DB.OpenRecordset("SELECT [Inventory.ITM_NO] FROM [OAUSER.Inventory] WHERE [Inventory.ITM_NO]=" & ItemNum & ";", dbOpenDynaset)
For Each c In ActiveSheet.Selection
ItemNum = c.Value
bFound = Not rs.EOF
If bFound Then
c.Interior.Color = RGB(255, 0, 0)
Else
c.Interior.Color = RGB(0, 255, 0)
End If
Next
rs.Close
Set rs = Nothing
DB.Close
Set DB = Nothing
End Sub
Thank you!
Matt

Answer 1

I suggest you use an IN in your where clause to bring over all the items in the selection, then filter the recordset for each item to see if it found it. I don't have your data setup, so I used a truck database that I have handy. You should be able to convert
Sub CheckTruckExists()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSql As String
Dim aInClause() As String
Dim rCell As Range
Dim vaTrucks As Variant
Dim i As Long
'Open a connection to the database
Set cn = New ADODB.Connection
cn.Open sCONNECTIONSTRING
'Get an array of values from the selection
vaTrucks = Selection.Value
'Increase the size of the one-dimensional array to match
ReDim aInClause(LBound(vaTrucks, 1) To UBound(vaTrucks, 1))
'Fill a one-dim array from the two-dim array so we can Join it
For i = LBound(vaTrucks, 1) To UBound(vaTrucks, 1)
aInClause(i) = vaTrucks(i, 1)
Next i
'Build the SQL statement and execute it
sSql = "SELECT ReportTruck FROM qryTrucks WHERE ReportTruck IN ('" & Join(aInClause, "','") & "')"
Set rs = New Recordset
Set rs = cn.Execute(sSql)
'Loop through the selected cells
For Each rCell In Selection.Cells
'clear the filter, then refilter the recordset on the filtered value
rs.Filter = adFilterNone
rs.Filter = "ReportTruck = '" & rCell.Value & "'"
'If the filter returned zero records, it's eof
If rs.EOF Then
rCell.Interior.Color = RGB(255, 0, 0)
Else
rCell.Interior.Color = RGB(0, 255, 0)
End If
Next rCell
End Sub
My ReportTruck field is a String, so I have to enclose all the trucks in my IN clause with single quotes. If you're looking for something other than a String, modify the Join to accommodate that data type.
Also, there's no error checking to makes sure the Selection is actually a Range object or that it contains more than one cell - both are necessary to avoid an error.