Multiple lookup in a closed workbook using ADO Connection - excel

Question

From the below Image I want to compare Second Workbook(Records.xlsm) with First Workbook(HandBook.xlsm)
I want to check if Department ID and Course ID Combination is valid by comparing it with the first workbook(HandBook.xlsm) and highlight in yellow if the combination doesn't exist.
But When i tried to write the code,I was able to check only the first record, i.e in the below example Dept Id 3000 has three different course ID but when I try to compare it is validating only with the first record occurrence 3000-123 , if I try to put any other combination 3000-124 or 3000-125 it is highlighted as error which should not be the case.
Columns("B:B").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "=IF(OR(NOT(ISERROR(MATCH(RC[2],INDEX('[HandBook.xlsm]Dept-Course'!C2,MATCH(RC[1],'[HandBook.xlsm]Dept-Course'!C1,0),0),0)))),"""",""ERROR"")"
Selection.Copy
Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select
If ActiveCell.Row > 2 Then
Range(Selection, Selection.End(xlUp)).Select
End If
ActiveSheet.Paste

Answer 1

I prepared 2 solutions for you. The first doesn't require VBA. But it needs a helper column and this is why I think you won't like it. However, you may like to try. In the helper column enter this formula.
=SUMPRODUCT(('[082 STO 200829 Records.xlsm]Records'!$A:$A=C2)*('[082 STO 200829 Records.xlsm]Records'!$B:$B=D2))
The referenced workbook must be open at the time of writing the formula. After that it can be closed. The formula will return either 1 or 0 depending upon whether a match was found in the referenced file. Observe that column A:A in the referenced sheet holds data similar to C2 and B:B has that same relationship with D2. The result you can use to highlight cells using conditional formatting.
Select the first pair of Department/Course IDs on your Handbook sheet.
Create a New Rule to conditionally format these cells depending upon a formula. (In my worksheet that was C2:D2)
Insert this formula: =$E2=0 (In my example E:E is the helper column)
Choose the highlight you like.
Before you close the dialog correct the range to which the formula applies. The field originally shows just the selected cells. Extend the range all the way down your sheet. You might also have selected all to begin with but I prefer this way if the range is big and you don't want to drag the selection forever.
I prepared a VBA solution as well but I didn't much like that, either. It's a lot of code compared with your humble beginnings and that is before I got around to dealing with the screen flicker as the referenced file is opened and closed. I'm not sure I shall be able to deal with that entirely.
Therefore I abandoned that attempt when it was nearly done and now work on a solution that doesn't open the referenced workbook. I shall come back to publish it here later today.
Meanwhile I think the above solution has much to speak for it by way of simplicity. Bear in mind that you can have the helper column anywhere on the sheet, and you can hide it as well.

Answer 2

There are two parts of the code for this solution which must be placed exactly where they belong. The first part is an event procedure. It fires automatically when the user changes either the Department or the Course in the Handbook. This Change event will not be noticed anywhere in your workbook except in the worksheet concerned. Therefore the code must be in that tab's code module. That is an existing module, set up by Excel for this purpose.
The second part of the code deals with the external workbook which I identified as "Records.xlsm". Therefore I prefer it to be in a standard code module. That is a module you set up yourself. The default name will be Module1 but I (with the support of all but the most new newbies at programming) recommend to give a descriptive name. In my copy of the workbook I named it ADO_Conn for the ADODB Connection it contains.
In addition to the ADODB connection this part also contains various parameters which you may adjust to match your needs and liking. They take the shape of enumerations which offer an efficient way to allot names to numeric constants. I placed them here because some of them are used in both parts of the code. Their point is to let you make the code work differently without digging into the code itself. You just twiddle the knobs, as it were.
If you followed me thus far you may have noticed that there is no code for you to press a button or F5 so that it runs. The ADODB connection is called by the event procedure and the event procedure is triggered by the changes the user makes on the worksheet. The functionality is simple. When the user makes a change the macro looks for the combination of Department and Course and marks the cells if it isn't found. If the user thereupon changes the entry the process is repeated and the highlight may be removed. However, no change is triggered by a subsequent change in the Records. Such changes should be driven by change events in the Records workbook.
The more automation you want the more precise must be the setup. Start by copying part 2, here following, to a standard code module called ADO_Conn (if you like). Observe that the name avoids a space by substituting it with an underscore. This rule will also apply to the names of the two columns in Records that will be accessed. I renamed them as "Dept_ID" and "Course_ID". You can use different names, shift the columns to other locations, but you may not include any blanks in these names, nor should you change their sequence in the one place in the code where they are mentioned. If the names in the code differ from those in the workbook the workbook will still work but the code won't. Here is part 2.
Option Explicit
Enum Nwt ' worksheet Target ("Handbook" = ThisWorkbook)
' 082
NwtFirstDataRow = 2 ' change to suit
NwtDept = 3 ' Columns: 3 = C
NwtCourse ' if no value is assigned, [preceding + 1]
End Enum
Enum Nct ' search criteria: TriggerRng()
' 082
NctDept = 1 ' do not change (!!)
NctCourse
End Enum
Function HasMatch(Crits As Variant, _
SrcFile As String, _
SrcTab As String, _
SrcClms As String) As Boolean
' 082
Dim ConSpec As String
Dim Conn As Object ' late-bound ADODB.Connection
Dim Rs As Object ' late-bound ADODB.Recordset
Dim Query As String ' SQL query
Dim Sp() As String ' array of Clms
On Error GoTo ErrExit
' Create the record set and ADODB connection
Set Rs = CreateObject("ADODB.Recordset")
Set Conn = CreateObject("ADODB.Connection")
With Conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & SrcFile & ";" & _
"Extended Properties=""Excel 12.0;" & _
"HDR=Yes;" & _
"IMEX=1"";"
.Open
End With
' create the SQL query string
Sp = Split("," & SrcClms, ",") ' first column index = 1
Query = "SELECT " & Sp(NctDept) & _
" FROM [" & SrcTab$ & "$]" & _
" WHERE " & Sp(NctDept) & " = " & Crits(1, NctDept) & _
" AND " & Sp(NctCourse) & " = " & Crits(1, NctCourse) & ";"
Rs.Open Query, Conn, 0, 1, 1 ' execute the query
' evaluate the retrieved recordset
HasMatch = Rs.EOF
ErrExit:
If Err Then
MsgBox "An error occurred during data retrieval:-" & vbCr & _
Err.Description, _
vbExclamation, "Error No. " & Err.Number
End If
Err.Clear
End Function
There are 2 sets of Department/Course ID numbers. The columns used in the Handbook sheet and an ID for each that the program itself uses. You can move the columns to where you want them. They don't have to stay together but I think the Department column must stay to the left of the Course column. Just change the numbers assigned to the names and the program will find them. You can also change the FirstDataRow for the Handbook sheet. But the the Records sheet only one header row is allowed - fixed, therefore not adjustable.
Here is the first part of the code. Paste it to the code module of the worksheet in Handbook where you want your entries checked.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' 082
' name the source workbook with its complete path (change to match your facts)
Const SrcPath As String = "D:\PVT Archive\Class 1\1-2020 (Jan 2022)\" ' end on \
Const SrcFile As String = "082 STO 200829 Records.xlsm"
Const SrcTab As String = "Records"
' match the column names in the workbook with the names used here.
' If they are changed assign names without spaces in them and
' maintain their logical sequence.
Const SrcClms As String = "Dept_ID,Course_ID"
Dim Matched As Boolean ' apply no highlight if True
Dim TriggerRng As Range ' the range that triggers action
Dim Crits As Variant ' search criteria
' don't react to changes in more than one cell
If Target.CountLarge > 1 Then Exit Sub
Set TriggerRng = Range(Cells(NwtFirstDataRow, NwtDept), _
Cells(Rows.Count, NwtDept).End(xlUp))
Set TriggerRng = Application.Union(TriggerRng, TriggerRng.Offset(0, NwtCourse - NwtDept))
If Not Intersect(Target, TriggerRng) Is Nothing Then
With Target
Set TriggerRng = Application.Union(Cells(.Row, NwtDept), _
Cells(.Row, NwtCourse))
Crits = TriggerRng.Value
If WorksheetFunction.CountA(TriggerRng) < 2 Then Exit Sub
End With
If Dir(SrcPath & SrcFile) = "" Then
' check if referenced workbook exists at the specified location
MsgBox "The workbook to be referenced" & vbCr & _
SrcFile & vbCr & "can't be found at" & vbCr & _
SrcPath & ".", _
vbInformation, "Data source not accessible"
Exit Sub
End If
With TriggerRng
If HasMatch(Crits, SrcPath & SrcFile, SrcTab, SrcClms) Then
.Interior.Color = vbYellow
Else
.Interior.Pattern = xlNone
End If
End With
End If
End Sub
There are 4 constants to be set by you. This must be done very precisely. You may also like to review the text of the messages, and I shall not mind if you improve them to better suit your needs. The rest of the code is intended to stay untouched. Whatever modifications you want must be done by using the parameters, unless you find flaws in the functionality, which I hope you will not.
SrcPath holds the path to the workbook Records. It must end on a backslash "". SrcFile holds the name of that file. This program doesn't mind if it's open or closed. SrcTab holds the name of the worksheet. I suspect that having a space in it might cause a problem. So, better avoid one. Finally, SrcClms gives the names of the column captions of the two columns in Records that we are concerned with here. Keep them aligned with what they really are, keep them free from blanks and keep their sequence aligned with the Enum Nct. Mind that ADO (ActiveX Data Object, btw) doesn't allow you to have more than 1 header row in the Records sheet. Not that it should make any difference in this particular application if there were more, unless the header rows contain potential matches. However, avoid having merged cells on that sheet anywhere.