We all know about the evils of Lookup fields and why they are to be avoided at all costs! If you aren’t already familiar with why they are to never be used, then take a few moments to review The Evils of Lookup Fields in Tables (pay special attention regarding Upsizing should you ever think you will need to eventually port your db to SQL Server, or another RDMS one day!) and Did I Mention I Have a Thing Against Lookup Fields in Tables?.

The problem is that many novice developers are not aware of the above and use them, some abundantly. So when I take over their projects I need to easily find these fields so I can remove them and set things up properly. As such, here is a simple little procedure I put together that will list all the table lookup field in a database.

'---------------------------------------------------------------------------------------
' Procedure : Tables_FindLookupFields
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Identify all the table fields that are set as a Lookup (to be avoided!!!)
'             Results are displayed in the immediate window
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' None
'
' Usage:
' ~~~~~~
' ? Tables_FindLookupFields
' Call Tables_FindLookupFields
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2015-02-29              Initial Release
' 2         2017-05-23              Added DisplayControlType Conversion Function
' 3         2018-09-20              Updated Copyright
'---------------------------------------------------------------------------------------
Public Function Tables_FindLookupFields() As String
' https://msdn.microsoft.com/en-us/library/cc185703(v=office.12).aspx
    On Error GoTo Error_Handler
    Dim tdf                   As DAO.TableDef
    Dim fld                   As DAO.Field
    Dim prp                   As DAO.Property

    Application.Echo False
    Debug.Print "Searching for Lookup Fields"
    Debug.Print "Table Name", "Fld Name", "DisplayControl Type"
    Debug.Print String(80, "-")

    For Each tdf In CurrentDb.TableDefs    'Loop through each table
        If Left(tdf.Name, 4) <> "MSys" Then    'Don't mess with system tables!
            For Each fld In tdf.Fields    'Loop through each field
                Set prp = fld.Properties("DisplayControl")
                If Not prp Is Nothing Then
                    If prp <> acTextBox Then Debug.Print tdf.Name, fld.Name, DisplayControlType(prp)
                End If
                Set prp = Nothing
            Next fld
        End If
    Next tdf

    Debug.Print String(80, "-")
    Debug.Print "Search Complete"

Error_Handler_Exit:
    On Error Resume Next
    Application.Echo True
    If Not prp Is Nothing Then Set prp = Nothing
    If Not fld Is Nothing Then Set fld = Nothing
    If Not tdf Is Nothing Then Set tdf = Nothing
    Exit Function

Error_Handler:
    If Err.Number = 3270 Then
        'Property doesn't exits
        Resume Next
    Else
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: Tables_FindLookupFields" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
        Resume Error_Handler_Exit
    End If
End Function

Function DisplayControlType(ByVal DisplayControl As Integer) As String
'Purpose: Converts the numeric results of DAO DisplayControl to plain English text
    Select Case CLng(DisplayControl)
        Case 106
            DisplayControlType = "Check Box"
        Case 109
            DisplayControlType = "Text Box"
        Case 110
            DisplayControlType = "List Box"
        Case 111
            DisplayControlType = "Combo Box"
        Case Else
            DisplayControlType = "Unknown/" & DisplayControl
    End Select
End Function