Attribute VB_Name = "RecsetDiff"
'============================================================================
'Module RecsetDiff:
'
'Compare equivalent data fields in two tables
'where records should have the same data for same-named columns.
'
'The tables are assumed to have single-column IDs
'with the same column name (e.g. [ID]), but possibly with different values.
'Sorting by ID is assumed to line-up equivalent records
'(i.e. record N from Table 1 should match record N from Table 2).
'============================================================================
Option Compare Database
Option Explicit

Const table1 As String = "Table1"
Const table2 As String = "Table2"

'Const table1 As String = "Table2"
'Const table2 As String = "Table3"

Const idcolumn As String = "[ID]"
Const datacolumns As String = "[B], [C]"
'Assume that matching columns have the same names in both tables

Dim log As String   'shared log variable, as several procedures write to it


Sub RunDiff()
'Compare the data columns in the two tables specified above
'Write any differences to the log string, and display the final result.

    Dim recset1 As ADODB.Recordset
    Dim recset2 As ADODB.Recordset
    
    Set recset1 = Recset(table1, idcolumn, datacolumns)
    Set recset2 = Recset(table2, idcolumn, datacolumns)
    
    Compare recset1, recset2
    
    If Len(log) = 0 Then log = "Tables match"
    
    MsgBox log
End Sub

Function Recset(tablename As String, idcolumn As String, datacolumns As String) _
                As ADODB.Recordset
'Create and open a Recordset that contains the specified columns
'from the specified table.

    Set Recset = New ADODB.Recordset
    With Recset
        .ActiveConnection = CurrentProject.Connection
        .CursorType = adOpenForwardOnly
        .LockType = adLockReadOnly
    End With
    
    Dim sql As String
    sql = "SELECT " & idcolumn & ", " & datacolumns & _
            " FROM " & tablename & _
            " ORDER BY " & idcolumn
                                                    'Debug.Print sql
    Recset.Open sql
    
End Function

Sub Compare(recset1 As ADODB.Recordset, recset2 As ADODB.Recordset)

    log = ""

    Do Until recset1.EOF Or recset2.EOF
        CompareRecords recset1, recset2
        
        recset1.MoveNext
        recset2.MoveNext
    Loop
    
    CheckEOFs recset1, recset2

End Sub

Sub CompareRecords(recset1 As ADODB.Recordset, recset2 As ADODB.Recordset)
'Compare the data fields in the current records from the two Recordsets

    Dim fieldcount As Integer
    fieldcount = recset1.Fields.Count
    
    Dim isok As Boolean
    Dim id1 As String, id2 As String
    Dim field1 As ADODB.Field, field2 As ADODB.Field
    Dim i As Integer
    
    For i = 1 To (fieldcount - 1)
                'Fields is zero-based
                'we do not compare Fields(0) which is the record ID
        Set field1 = recset1.Fields(i)
        Set field2 = recset2.Fields(i)
        
        isok = CompareFields(field1, field2)
        If Not isok Then
            id1 = recset1.Fields(0).Value
            id2 = recset2.Fields(0).Value
        
            LogMismatch id1, id2, field1, field2
        End If
    Next

End Sub

Function CompareFields(field1 As ADODB.Field, field2 As ADODB.Field) As Boolean
'Compare two equivalent fields, allowing for Null values.
'We could implement alternative testing functions here.

    If Not IsNull(field1.Value) And Not IsNull(field2.Value) Then
        CompareFields = (field1.Value = field2.Value)
    ElseIf IsNull(field1.Value) And IsNull(field2.Value) Then
        CompareFields = True
    Else
        CompareFields = False
    End If

End Function

Sub LogMismatch(id1 As String, id2 As String, _
                field1 As ADODB.Field, field2 As ADODB.Field)
'Add a mismatch line to the log string

    log = log & vbCrLf & _
            id1 & " : " & field1.Name & " = " & field1.Value & "  -X-  " & _
            id2 & " : " & field2.Name & " = " & field2.Value

End Sub

Sub CheckEOFs(recset1 As ADODB.Recordset, recset2 As ADODB.Recordset)
'Check that the two Recordsets have both reached EOF together.
'Add a message to the log string if not.

    If Not recset1.EOF Then
        log = log & vbCrLf & _
                "Additional records in Table 1, from key " & recset1.Fields(0).Value
    ElseIf Not recset2.EOF Then
        log = log & vbCrLf & _
                "Additional records in Table 2, from key " & recset2.Fields(0).Value
    End If

End Sub