Link to home
Start Free TrialLog in
Avatar of centralmike
centralmike

asked on

I need to compare one access table to another to show missing columns and output columns to a table.

I need to know if it possible to loop through a recordset(tblViewNames) comparing one table to another.  I need to be able to output column that don't exist in the BI View tables from the CR tables . I have a sample query created in Teradata  where it shows BI columns missing from the CR Tables comparison.  Then I need to output this missing columns to a table(tblFinalOutput).
td_example.xlsx
Edge_Ticket.accdb
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

This seems to work:

Option Compare Database
Option Explicit

Public Function MissingFields( _
    ByVal Source As String, _
    ByVal Target As String) _
    As Variant

    Dim dbs     As DAO.Database
    Dim tbs     As DAO.TableDef
    Dim tbt     As DAO.TableDef
    Dim fls     As DAO.Field
    Dim flt     As DAO.Field
    
    Dim Found   As Boolean
    Dim Index   As Integer
    Dim Names() As String
    
    Set dbs = CurrentDb
    Set tbs = dbs.TableDefs(Source)
    Set tbt = dbs.TableDefs(Target)
    
    ReDim Names(tbs.Fields.Count - 1, 1)
    
    For Each fls In tbs.Fields
        For Each flt In tbt.Fields
            If fls.Name = flt.Name Then
                Found = True
                Exit For
            End If
        Next
        If Not Found Then
            Names(Index, 0) = tbs.Name
            Names(Index, 1) = fls.Name
            Index = Index + 1
        End If
        Found = False
    Next
    
    MissingFields = Names
    
End Function

Public Sub InsertMissingFields( _
    ByVal Source As String, _
    ByVal Target As String)

    Dim rs      As DAO.Recordset

    Dim Index   As Integer
    Dim Names   As Variant
    
    Set rs = CurrentDb.OpenRecordset("select * From tblFinalOutput")
    Names = MissingFields(Source, Target)
    
    For Index = LBound(Names, 1) To UBound(Names, 1)
        If Names(Index, 0) <> "" Then
            rs.AddNew
                rs!TablesName.Value = Names(Index, 0)
                rs!ColumnName.Value = Names(Index, 1)
            rs.Update
            Debug.Print Names(Index, 0), Names(Index, 1)
        End If
    Next
    rs.Close
        
End Sub

Public Sub Test()

    InsertMissingFields "MA_P_MDM_BI_VW_V_POLICY_DIM", "MA_P_MDM_CR_VW_V_POLICY"
    
End Sub

Open in new window

Run the Test in the attached demo.
Edge_Ticket.accdb
I don't think it is doable with a query, as it will require to query the system tables, wich hold obscure (and undocumented) data.

But with VBA, you can obtain a tabledef object wich represent a table, and loop trough its fields collection.
Sample code for Excel:
Public Sub test()
    Const acQuitSaveNone As Byte = 2

    Dim app As Object       '// Access.Application
    Set app = CreateObject("Access.Application")
    
    Dim db As Object        '// DAO.Database
    Set db = app.DBEngine.Workspaces(0).OpenDatabase(ThisWorkbook.Path & "\Edge_Ticket.accdb")
    
    Dim columnList As Collection
    Set columnList = GetMissingColumns(db.TableDefs("MA_P_MDM_BI_VW_V_POLICY_DIM"), db.TableDefs("MA_P_MDM_CR_VW_V_POLICY"))
    
    db.Close
    app.Quit acQuitSaveNone
    
        '// Do whatever you want with the collection here
    
End Sub

'// Private Function GetMissingColumns(ByRef left As DAO.TableDef, ByRef right As DAO.TableDef) As Collection
Private Function GetMissingColumns(ByRef left As Object, ByRef right As Object) As Collection
    Dim columnList As Collection
    Set columnList = New Collection
    
    Dim field As Object     '// DAO.field
    For Each field In right.Fields
        If Not (ExistInCollection(field.Name, left.Fields)) Then
            columnList.Add field.Name
        End If
    Next
    Set GetMissingColumns = columnList
End Function

Private Function ExistInCollection(ByVal key As String, ByRef col As Object) As Boolean
    ExistInCollection = ExistInCollectionByVal(key, col) Or ExistInCollectionByRef(key, col)
End Function

Private Function ExistInCollectionByVal(ByVal key As String, ByRef col As Object)
On Error GoTo Error
    Dim item As Variant
    item = col(key)
    ExistInCollectionByVal = True
Exit Function
Error:
    ExistInCollectionByVal = False
End Function

Private Function ExistInCollectionByRef(ByVal key As String, ByRef col As Object)
On Error GoTo Error
    Dim item As Variant
    Set item = col(key)
    ExistInCollectionByRef = True
Exit Function
Error:
    ExistInCollectionByRef = False
End Function

Open in new window

Avatar of centralmike
centralmike

ASKER

Gustav - Is there a way to loop through the re
Gustav is there way to loop through the recordset, so you don't have to do one table at a time?
Recordset is an object that hold data from a data source (a table or a query), it doesn't hold table names.

With teh code provided by Gustav, and by me, you need to provide the table names you want to compare, as we have no way to deduce it.
Yes, you can expand my Test function to loop the table names:

Public Sub Test()

    Dim db      As DAO.Database
    Dim td      As DAO.TableDef
    
    Dim Source  As String
    Dim Target  As String
    
    Set db = CurrentDb
    For Each td In db.TableDefs
        Source = td.Name
        If Left(Source, 3) = "MA_" Then
            If InStr(1, Source, "_BI_", vbTextCompare) > 0 Then
                ' Chop off "_DIM".
                Target = Left(Replace(Source, "_BI_", "_CR_"), Len(Source) - 4)
                Debug.Print Source, Target
                InsertMissingFields Source, Target
            End If
        End If
    Next

End Sub

Open in new window

See the attached demo, please.
Edge_Ticket_2.accdb
Gustav, I think you are pretty close.  I didn't want to incorrectly change the logic.  But it's comparing BI layer to the CR layer.  It  should be comparing the CR to the BI.   The first test module work correctly.  When you added the logic to loop through the recordset the BI  and CR layers somehow got reversed.
First set of code the worked correctly.  Second set reversed the comparison.
CALL TEST()
MA_P_MDM_CR_VW_V_POLICY     POLICY_ROW_SEQ_ID
MA_P_MDM_CR_VW_V_POLICY     APP_SIGNED_REGION_VALUE_CDE
MA_P_MDM_CR_VW_V_POLICY     APP_ENTRY_OPERATOR_ID
MA_P_MDM_CR_VW_V_POLICY     APP_SUBMISSION_METHOD_CDE
MA_P_MDM_CR_VW_V_POLICY     APP_SOURCE_SYSTEM_CDE
MA_P_MDM_CR_VW_V_POLICY     APP_FORM_NME
MA_P_MDM_CR_VW_V_POLICY     LINE_OF_BUSINESS_CATEGORY_ID
MA_P_MDM_CR_VW_V_POLICY     ETL_STAGE_TAG_ID
MA_P_MDM_CR_VW_V_POLICY     UNIQUE_ROW_ID
Then it probably is:

Public Sub Test2()

    Dim db      As DAO.Database
    Dim td      As DAO.TableDef
    
    Dim Source  As String
    Dim Target  As String
    
    Set db = CurrentDb
    For Each td In db.TableDefs
        Source = td.Name
        If Left(Source, 3) = "MA_" Then
            If InStr(1, Source, "_CR_", vbTextCompare) > 0 Then
                ' Append "_DIM".
                Target = Replace(Source, "_CR_", "_BI_") & "_DIM"
                Debug.Print Source, Target
                InsertMissingFields Source, Target
            End If
        End If
    Next

End Sub

Open in new window

See the attached, please.
Edge_Ticket_2.accdb
Gustav, I added couple more tables to the database and seems to have broken the logic.  Instead of looping through the table def collections of the database.  Would the logic work if you looping through a recordset "tblViewnames".  Hopefully this question makes a little more sense. If  you run test module 4.  You will see the results in tblFinalOutput.  The code seems to skip several tables.
Edge_Ticket_exp.accdb
ASKER CERTIFIED SOLUTION
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Gustav, Sorry for misunderstanding. I see your just calling the function in a query.
Thank you very Gustav  I have better understanding of access objects.
You are welcome!