Comparing recordset values in Access VBA - vba

I am trying to compare two recordsets in access VBA to check whether the values within the two tables are the same or whether they differ. Both recordsets have the same structure (field headings) and record IDs and I'm trying to check whether a field value for a record matches the corresponding field value in the second recordset. The record ID field name is MATNR.
I think I've managed to loop through the records and fields for the 1st recordset but I'm unsure how to loop through and compare these records with the second. Also, is there a smarter way to compare the recordsets other than If rs1.Fields(fld.Name) = rs2.Fields(fld.Name)
Any help will be greatly appreciated.
Public Sub VerifyRecords()
Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Dim fld As DAO.Field
Dim sSQL As String
Dim sSQL1 As String
Dim sSQL2 As String
Set rs = CurrentDb.OpenRecordset("R2_Tables_to_Compare1") 'This table lists the upload tables to query and their corresponding target tables
Set rs3 = CurrentDb.OpenRecordset("RecordValueComparisonResults") 'Write the results of the record vlaue comparison to here
'**************************************************************************************
'This SQL statement selects all records from the upload table
sSQL = "SELECT * "
sSQL = sSQL & " FROM " & rs(0)
Set rs1 = CurrentDb.OpenRecordset(sSQL)
'**************************************************************************************
'This SQL statement selects only those records that are applicable in the target table
sSQL1 = "SELECT " & rs(1) & ".* FROM " & rs(1) & " INNER JOIN " & rs(0) & " ON " & rs(1) & ".MATNR = " & rs(0) & ".MATNR"
Set rs2 = CurrentDb.OpenRecordset(sSQL1)
'**************************************************************************************
Do While Not rs1.EOF
For Each fld In rs1.Fields
If rs1.Fields(fld.Name) = rs2.Fields(fld.Name) Then
Debug.Print rs1.Fields("MATNR"), rs2.Fields("MATNR"), fld.Name, rs1.Fields(fld.Name), rs2.Fields(fld.Name)
End If
Next fld
rs1.MoveNext
Loop
rs.Close
rs1.Close
rs2.Close
rs3.Close
Set rs = Nothing
Set rs1 = Nothing
Set rs2 = Nothing
Set rs3 = Nothing
End Sub

Below are two options, although the QUERY OPTION is faster and better practice when working in Access and any relational DB:
QUERY OPTION: This query could be passed into a recordset and the recordset would contain only the matching values between the fields in the two tables. Then you could loop through that new recordset and print or process as necessary using a single loop.
SELECT column_name FROM table1 INNER JOIN table2 ON table1.column_name = table2.column_name;
LOOP OPTION: If you are intent on looping through both recordsets, use this code. There is probably a more efficient way to do this, especially since this method uses four nested loops which is a no-no. I would highly recommend the QUERY OPTION.
While Not rs1.EOF
While Not rs2.EOF
For Each fld1 in rs1.Fields
For Each fld2 in rs2.Fields
If rs1.Fields(fld1.Name) = rs2.Fields(fld2.Name) Then
Debug.Print rs1.Fields("MATNR"), rs2.Fields("MATNR"), fld1.Name,
rs1.Fields(fld1.Name), rs2.Fields(fld2.Name)
End If
Next fld2
Next fld1
rs2.MoveNext
Wend
rs2.MoveFirst
rs1.MoveNext
Wend

Related

I was wondering why am I getting this error?

(fake entries and file directories)
This is the error I got when trying to run a macro that takes values from a query and assigns them to a bookmark'd location on a word .docx
this is the line it fails on
Set rs = CurrentDb.OpenRecordset("Query1", dbOpenDynaset)
this is the query that the vba code is taking values from
SELECT Table1.ProjectNo, Table1.FirstName, Table1.LastName, Table1.Phone, Table1.ProjectName, Table1.EMail, Table1.Client
FROM Table1
WHERE (((Table1.LastName) Like "*" & [Forms]![Form3]![SearchBox] & "*"));
Private Sub Command9_Click()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim rs As DAO.Recordset
Set wApp = New Word.Application
Set wDoc = wApp.Documents.Open("C:\Documents\ECORtester.docx")
Set rs = CurrentDb.OpenRecordset("Query1", dbOpenDynaset)
If Not rs.EOF Then rs.MoveFirst
Do Until rs.EOF
wDoc.Bookmarks("Attention").Range.Text = Nz(rs![FirstName], "") & Nz(rs![LastName], "")
wDoc.Bookmarks("Client").Range.Text = Nz(rs![Client], "")
wDoc.Bookmarks("Email").Range.Text = Nz(rs![Email], "")
wDoc.Bookmarks("Phone").Range.Text = Nz(rs![Phone], "")
wDoc.Bookmarks("ProjectName").Range.Text = Nz(rs![ProjectName], "")
wDoc.Bookmarks("ProjectNumber").Range.Text = Nz(rs![ProjectNo], "")
wDoc.SaveAs2 "C:\Documents" & rs!ProjectNumber & "_ECORtester.docx"
rs.MoveNext
Loop
End Sub
Your WHERE clause has a parameter in it that isn't being set.
Define it as a querydef and create the recordset from that.
Dim qdf As QueryDef
Dim rs As Recordset
Set qdf = CurrentDb.QueryDefs("Query1")
qdf.Parameters("[Forms]![Form3]![SearchBox]") = [Forms]![Form3]![SearchBox]
Set rs = qdf.OpenRecordset
Recordset based on query object that has undefined/unset dynamic parameter won't work. Instead, base recordset on table and build SQL in VBA.
strSQL = "SELECT * FROM Table1 WHERE LastName Like "*" & [Forms]![Form3]![SearchBox] & "*"
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Using LIKE with wildcard could return multiple clients. If there are multiple people with same/similar last name, they could all be retrieved. If you want only one client, then use unique record ID as filter criteria. A combobox may be more useful than a free-form input textbox. With code, combobox can implement pattern matching and 'filter as you type' functionality but then selection is made from listed items and unique ID is available.

Find unmatched record and specify the field

I want your kind help to give a solution to match between two tables and return unmatched recorda with a field specify which field was unmatched.
Take a note that each table including more than 30 fields.
You can use recordsets but if your tables are long this might take a while. This is absolutely not optimized, but considering how little information you provided, I don't want to invest a whole lot of time.
I am assuming your tables are identical in structure, sorted identically, and have the same number of records. If not, feel free to adapt this however you see fit, but you should be able to get the idea of what I am doing.
It will output the field and row number of Table1 in the immediate window when a mismatch is found. You could also insert it into a temp table if you want to recover all of the field values, but again, I don't want to go that far. So this has limitations:
Public Function FindMisMatches(Table1 As String, Table2 As String)
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim i As Integer
Dim Row As Integer
On Error GoTo PROC_ERR
Set db = CurrentDb
Set rs1 = db.OpenRecordset(Table1, dbOpenSnapshot, dbReadOnly)
Set rs2 = db.OpenRecordset(Table2, dbOpenSnapshot, dbReadOnly)
rs1.MoveFirst
rs2.MoveFirst
Row = 1
Do Until rs1.EOF Or rs2.EOF
'Assuming both tables have identical structure
For i = 1 To rs1.Fields.Count - 1
If rs1.Fields(i).Value <> rs2.Fields(i).Value Then
Debug.Print "Mismatch in field " & rs1.Fields(i).Name & " on row " & Row
End If
Next i
rs1.MoveNext
rs2.MoveNext
Row = Row + 1
Loop
Debug.Print "End of recordset"
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
Exit Function
PROC_ERR:
MsgBox "Error: " & Err.Number & "; " & Err.Description
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Function

MS Access Insert Into Slow for Large Recordset (VBA)

I have a section of code which creates a new table and then attempts to copy the record set values into the table. The only problem is this it is quite slow and access shows the loading symbol whilst it is executing this insert section below. Currently this problem is occurring inserting 500 records, but I will need to insert around 10,000 to 20,000 when I get a final data set.
I = 1
DoCmd.SetWarnings False
RecordSet1.MoveFirst
Do While Not RecordSet1.EOF = True
SQL = "INSERT INTO " & FullName & " ("
For Each field In RecordSet1.fields()
SQL = SQL & " " & Replace(field.Name, ".", "_") & ","
Next field
SQL = SQL & "ValidationCheck)"
SQL = SQL & " VALUES("
For Each field2 In RecordSet1.fields()
SQL = SQL & "'" & field2.Value & "',"
Next field2
SQL = SQL & Matches(I) & ")"
DoCmd.RunSQL (SQL)
RecordSet1.MoveNext
I = I + 1
Loop
What I want to know is, is there any way I can speed this up? Or are there better approaches?
(What I am trying to do is create a table at run time with a unique set of fields from a RecordSet and add an extra column with a Boolean value stored in Match array for each Record). The creation works fine, but the insertion code above is very slow.
Yes, use DAO. So much faster. This example copies to the same table, but you can easily modify it so copy between two tables:
Public Sub CopyRecords()
Dim rstSource As DAO.Recordset
Dim rstInsert As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
Dim lngLoop As Long
Dim lngCount As Long
strSQL = "SELECT * FROM tblStatus WHERE Location = '" & _
"DEFx" & "' Order by Total"
Set rstInsert = CurrentDb.OpenRecordset(strSQL)
Set rstSource = rstInsert.Clone
With rstSource
lngCount = .RecordCount
For lngLoop = 1 To lngCount
With rstInsert
.AddNew
For Each fld In rstSource.Fields
With fld
If .Attributes And dbAutoIncrField Then
' Skip Autonumber or GUID field.
ElseIf .Name = "Total" Then
' Insert default value.
rstInsert.Fields(.Name).Value = 0
ElseIf .Name = "PROCESSED_IND" Then
rstInsert.Fields(.Name).Value = vbNullString
Else
' Copy field content.
rstInsert.Fields(.Name).Value = .Value
End If
End With
Next
.Update
End With
.MoveNext
Next
rstInsert.Close
.Close
End With
Set rstInsert = Nothing
Set rstSource = Nothing
End Sub
For multiple inserts in a loop, don't use SQL INSERT statements. Instead use a DAO.Recordset with .AddNew.
See this answer: https://stackoverflow.com/a/33025620/3820271
As positive side effects, your code will become better readable and you don't have to deal with the multiple formats for different data types.
For Each field In RecordSet1.Fields
rsTarget(field.Name) = field.Value
Next field

Referencing ListBox multiselect values in sql statement

I would like to open a recordset using matching values within a column of a multiselect listbox. At the moment my code only opens and edits the last record of the selection and I would like it to open all of them. Here is my code:-
Set oRSAppt = Application.CurrentDb().OpenRecordset("Select * FROM [Appointments] WHERE [SlotID] =" & ListBox.Column(7, ListBox.ItemsSelected))
With oRSAppt
If .BOF = True And .EOF = True Then
MsgBox "No records found", , "Failed"
Exit Sub
Else
.MoveFirst
Do While Not .EOF
.Edit
.Fields("Status").Value = "Invoiced"
.Fields("InvoiceID").Value = vInvoiceID
.Update
.MoveNext
Loop
.Close
End If
End With
This link suggests a for loop to get the selected values from the listbox
http://msdn.microsoft.com/en-us/library/office/ff823015%28v=office.15%29.aspx
but I am not sure how to do this within the sql statement or whether I should even go about it this way - and maybe I've just been looking at this for so long I've missed an obvious solution. Any help would be appreciated.
You will need to build your SQL statement first and yes, you need to use a loop. Something like this should do the trick:
Dim strSQL as String
Dim vItm as Variant
Dim oRSAppt As DAO.Recordset
For Each vItm In Me!Listbox.ItemsSelected
strSQL = strSQL & ListBox.Column(7, vItm) & ","
Next vItm
strSQL = left(strSQL,len(strSQL) - 1) ' remove last comma
Set oRSAppt = CurrentDb.OpenRecordset("Select * FROM [Appointments] " _
WHERE [SlotID] In (" & strSQL & ")")

Export Query in VBA loop to select data based on String Value

I have a table called TEST, which I have code below that loops an export query based on unique values in the column Territory.
The code is supposed to export data to excel files based on the unique values in the column Territory. So each Territory value would have it's own file.
I am having trouble with setting up the sql query and how to use the string value to select the data:
Sub TEST()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim v As String
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Select Distinct Territory From TEST")
Do While Not rs1.EOF
v = rs1.Fields(0).Value
**DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"WHAT SHOULD MY QUERY BE TO USE STRING v?", "C:\Users\me\Desktop\VBA_TEST\" v & ".xls", True**
rs1.MoveNext
Loop
rs1.Close
End Sub
Can someone guide me into how I may write the query and connect the string v so that it loops out reports?
Thank you!
I think you are required to use an existing query and not just your query as a string for the TransferSpreadsheet method. This means you will need a temporary query object to transfer your spreadsheet.
You can add a variable to query by joining it to the SQL string making sure that for text fields you include an ' on either side and leave it off for numeric fields.
Sub TEST()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim v As String
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Select Distinct Territory From TEST")
Dim strQry As String
Dim qdfTemp As DAO.QueryDef
Dim strQDF As String
strQDF = "_TempQuery_"
Do While Not rs1.EOF
v = rs1.Fields(0).Value
strQry = "SELECT * FROM TEST WHERE Territory = '" & v & "'"
Set qdfTemp = CurrentDb.CreateQueryDef(strQDF, strQry)
qdfTemp.Close
Set qdfTemp = Nothing
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
strQDF, "C:\Users\me\Desktop\VBA_TEST\" & v & ".xls", True
CurrentDb.QueryDefs.Delete strQDF
rs1.MoveNext
Loop
rs1.Close
End Sub