Logicwurks Home Page

Links To Excel Code Examples

Range/Wkb/Wks Variables
Add Grand Totals Using Ranges
Using Range Offset Property
Using Range Find Method
Union Of Ranges
Parse Range Strings
Delete Duplicate Rows
Delete Rows And Columns
Worksheet Variables
TypeName And TypeOf
Loop Through Worksheets
Loop Through Open Workbooks
Form Button Magic
Command Button Magic
Add Worksheets Dynamically
Find Last Row Or Column
Copy And Paste Special
Copy To Specific Cell Types
Range Copy With Filter
Open An Excel File
Open An Excel File w/Params
Open An Excel File On Web
Save A Workbook
Clone A Workbook
Test If WEB URL Exists
Parse Using Split Command
Color Management
Convert Cell Color To RGB
Sort Methods 2003 - 2010
Sort Alpha/Numeric In ASCII
Search Using Match Function
Search Using Vlookup Function
Using Find Instead of Vlookup
Remove String Non-Printables
Auto_Open And Auto_Close
Initialize Form At Open
Edit Numerics In UserForm
Load Combo And List Boxes
Floating Sheet Combo Boxes
Advanced User Form Coding
Excel Events
Worksheet Change Events
Binary Search Of Array
Typecast Constants
Excel Error Handling
Handling Optional Parameters
Data Validation Drop Downs
Read A Text File w/Handle
Write A Text File w/Handle
Read A Text Fiile w/Script
Text File Processing Examples
Test For Exists Or Open
Splash Screen
Dynamically Load Formulas
Date Examples
Date Find Same Days
Convert Month To Number
Initialize Arrays
Load Arrays Using Evaluate
Redim An Array
Reassign Button Action
Timer Functions
Legacy Calendar Control
Excel 2010 Date Picker
Date Picker Alternative
Generate Multiple Worksheets
Read Access Data Into Excel
Send Outlook Email w/Attach
Copy AutoFilters To Sheets
Export A Text File
Get Windows User Name
VBA Format Statement
Manipulate Files via VBA
Dynamically Load Images
Loop Through Worksheet Objects
Loop Through Form Objects
Loop Through Files with DIR
Active-X Checkboxes
Add Forms Checkboxes Dynam
Paste Pictures Into Excel
Copy Pictures Sheet To Sheet
Copy Pictures Sheet To Sheet
Create Forms Buttons With VBA
Extract Filename From Path
Convert R1C1 Format to A1
Special Cells Property

Links To Access Code Examples

Create Recordset With AddNew
Multi-Select List Boxes
Update Field(s) In A Recordset
Import A Tab Delimited File
Export Excel FileDialog
Create Excel Within Access
Open Excel Within Access
Open Excel OBJ From Access
Import Tab Delim w/WinAPI
Initialize Global Variables
Using TempVars For Globals
Access Error Handling
Loop Through Form Controls
Insert A Calendar Control
Create A Filtered Recordset
Populate Combo Boxes
Bookmarks And Forms
Combo Box Multiple Sources
Passing Form Objects
Create VBA SQL Statements
Create Dynamic Queries
Display File Images On A Form
Manipulate Files via VBA
Manipulate Files via Scripting
Number Subform Records
Reference Subform Objects
Parse Delimited Fields
Parameterized Queries (VBA)
Manipulating QueryDefs In VBA
FindFirst On Combined Keys
Using The Dlookup Command
Execute SQL Delete Records
Commit Form To Table
Report With No Data
Reference Form Objects
DSNLess Connections To MySQL
Print Active Form Record
Count Records in Linked Tables
Delete Empty Tables
Open Linked SQL Tables

 

Create Dynamic SQL Statements Using VBA

One of the more syntactically tricky procedures in VBA is to create a SQL statement using a combination of table or query elements along with dynamic variables. SQL statements are created for many uses, but two of the more common reasons are:

(1) Updating a Recordsource property for a combo box or other control
(2) Creating a SQL query for a record set

Three examples in the code below illustrate the VBA syntax to create a SQL statement. In these examples, I put the actual translated SQL statement in comments immediately below the SQL statement to show how they are actually rendered to the Jet Engine. Notice the use of the double-quote characters. The code below consists of "snippets" of a larger program and all the variables are not defined, since some of them are in the Global area of the program and others are form objects.

Program Code

Option Compare Database
Option Explicit
Option Base 1
' ******************************************************************
' Example 1 - The Row Source Is Dynamically Changed on the Combo Box
'             "Enter Event" using a Predefined Query in the
'             SQL Statement
' ******************************************************************
Private Sub cmbComboBox_Enter()
' ******************************************************************
' When The Combo Box Is Entered, Set Up Values to Be Displayed
' ******************************************************************
cmbComboBox.RowSource = _
"SELECT qryStylesForDropDownBox.Style FROM qryStylesForDropDownBox ORDER BY [Style];"
End Sub

' ******************************************************************
' Example 2 - Row Source Is Dynamically Changed on the Combo Box
'             Enter Event Using A Code-Created SQL Query --
'             Note How The """" Translates to One " in the Resulting
'             SQL Statement
' ******************************************************************
Private Sub cmbDefectCategory_Change()
strDefectCategory = cmbDefectCategory.Value

cmbSubCategory.RowSource = _
"SELECT tblDefectSubCategory.DefectSubCategory, tblDefectSubCategory.SubCategoryDescription" _
 & " FROM tblDefectSubCategory WHERE tblDefectSubCategory.DefectCategory = " _
 & """" & strDefectCategory & """" & " ORDER BY tblDefectSubCategory.SubCategoryDescription;"

' ******************************************************************
' The Above Statemnt Is Translated To the Following SQL Statement
' Given that strDefectCategory = "E"
' ******************************************************************
'SELECT tblDefectSubCategory.DefectSubCategory, tblDefectSubCategory.SubCategoryDescription
'FROM tblDefectSubCategory
'WHERE tblDefectSubCategory.DefectCategory = "E"
'ORDER BY tblDefectSubCategory.SubCategoryDescription;
End Sub

' ******************************************************************
' Example 3 - A Dynamic SQL Statement Is Created For A Query
'             Recordset.  Again, Note the Use of """"
' ******************************************************************
Private Sub cmdSelectDefectCode_Click()
Dim db As Database
Dim recIn As Recordset
Dim strSQL As String

intDefectCode = lstDefectDescriptions.Value

strSQL = _
"SELECT tblDefectCodes.DefectDescription FROM tblDefectCodes " & _
"WHERE (tblDefectCodes.DefectCode=" & intDefectCode & _
" AND tblDefectCodes.DefectCategory=" & """" & strDefectCategory & """" & ");"

' ******************************************************************
' The Above Statemnt Create The Following SQL String
' Given That intDefectCode = 2 and strDefectCategory = "E"
' ******************************************************************
'SELECT tblDefectCodes.DefectDescription
'FROM tblDefectCodes
'WHERE (tblDefectCodes.DefectCode=2 AND tblDefectCodes.DefectCategory="E");

Set db = CurrentDb()
Set recIn = db.OpenRecordset(strSQL)

If recIn.EOF Then
    strDefectDescription = "No Matching Description Found"
    Exit Sub
End If

strDefectDescription = recIn!DefectDescription

recIn.Close
db.Close
Set recIn = Nothing
Set db = Nothing

On Error GoTo Err_cmdCloseForm_Click

DoCmd.Close

Exit_cmdCloseForm_Click:
    Exit Sub

Err_cmdCloseForm_Click:
    MsgBox Err.Description
    Resume Exit_cmdCloseForm_Click

End Sub

Examples Of SQL Statements For Querydefs

' *************************************************************************************************
' This will show matching, records in table 1 not in table 2, and records in table 2 not in table 2.
' Sample of UNION Functionality
' *************************************************************************************************
SELECT Table1.ID, Table1.Date, Table1.Code, "Equal" AS Equal
FROM Table1 INNER JOIN Table2 ON (Table1.Date = Table2.Date) AND (Table1.ID = Table2.ID)
UNION
SELECT Table1.ID, Table1.Date, Table1.Code, "Table1Only" AS Table1Only
FROM Table1 LEFT JOIN Table2 ON (Table1.ID = Table2.ID) AND (Table1.Date = Table2.Date)
WHERE (((Table2.Code) Is Null))
UNION
SELECT Table2.ID, Table2.Date, Table2.Code, "Table2Only" AS Table2Only
FROM Table1 RIGHT JOIN Table2 ON (Table1.Date = Table2.Date) AND (Table1.ID = Table2.ID)
WHERE (((Table1.Code) Is Null));

' *************************************************************************************************
' Sample Of Select Within Select
' *************************************************************************************************
SELECT User, UserCount FROM
	(SELECT Table1.USER_NBR As User, Count(Table1.USER_CODE) AS UserCount
	 FROM Table1
	 GROUP BY Table1.USER_NBR
	 HAVING (Count(Table1.USER_CODE))=1) As A
INNER JOIN Table1 ON A.User = Table1.USER_NBR
WHERE (((Table1.USER_CODE)="00000"));

Examples of SQL Action and Select Queries not in QueryDefs

Option Compare Database
Option Explicit
' ******************************************************************
' These Variables Are Shared By All Procedures in This Form
' ******************************************************************
Dim varSelectedClientID As Variant
Dim lngClientIDToBePurged As Long
Dim strClientNameToPurge As String
Dim lngResponse As Long
Dim lngCurrentClientTransID As Long
Dim strSQLListEmployees As String
Dim db As DAO.Database
Dim recIn As DAO.Recordset
' ******************************************************************
' EEID Variables
' ******************************************************************
Dim lngEEIDKeyValues() As Long
Dim lngEEIDCount As Long
Dim lngEEIDTableIndex As Long
Dim lngEEIDKeyIndex As Long
Dim strSQL_EEIDRemoval As String
Dim strEEIDTablesToPurge(1 To 32) As String

' ******************************************************************
' Person Variables
' ******************************************************************
Dim lngPersonKeyValues() As Long
Dim varPersonID As Variant
Dim lngPersonCount As Long
Dim lngPersonIndex As Long
Dim lngPersonIDKeyIndex As Long
Dim varEEID As Variant
Dim strSQLDeletePersonData As String

' ******************************************************************
' ClientPlanID Variables
' ******************************************************************
Dim lngClientPlanIDKeyValues()
Dim lngClientPlanCount As Long
Dim strSQLExtractClientPlanIDs As String
Dim strSQLClientPlanIDRemoval As String
Dim strClientPlanTablesToPurge(1 To 3) As String
Dim lngClientPlanTableIndex As Long
Dim lngClientPlanKeyIndex As Long

' ******************************************************************
' PlanID Variables
' ******************************************************************
Dim lngPlanIDKeyValues()
Dim lngPlanCount As Long
Dim strSQLExtractPlanIDs As String
Dim strSQLPlanIDRemoval As String
Dim lngPlanIDIndex As Long
Dim strPlanTables(1 To 3) As String
Dim lngPlanTableIndex As Long
Dim varPlanID As Variant

' ******************************************************************
' TrustID Variables
' ******************************************************************
Dim lngTrustIDKeyValues()
Dim lngTrustCount As Long
Dim strSQLExtractTrustIDs As String
Dim strSQLTrustIDRemoval As String
Dim lngTrustIDIndex As Long
Dim strTrustTables(1 To 2)
Dim lngTrustTableIndex As Long

' ******************************************************************
' ClientTransID Variables
' ******************************************************************
Dim lngClientTransIDTableIndex As Long
Dim strSQL_ClientTransIDRemoval As String
Dim strSQL_ClientData_ClientTransIDRemoval As String
Dim varClientTransID As Variant

' ******************************************************************
' This Array Stores The Name of the Client Tables Which Contain
' The ClientTransID To Be Purged
' The first dimension is the table name
' The second dimension is what the table calls the ClientTransID
' ******************************************************************
Dim strClientIDTablesToPurge(1 To 40, 1 To 2) As String

' ******************************************************************
' Working Tables To Clear
' ******************************************************************
Dim strWorkingTableName(1 To 12) As String
Dim lngWorkingTableNameIndex As Long
Dim strSQLDeleteWorkingTableRows As String

' ******************************************************************
' Error Handler Variables
' ******************************************************************
Dim strProcName As String
Dim strErrorDescription As String
Dim lngErrNumber As Long

Private Sub cmdClearAllSelection_Click()
Call ClearAll
End Sub

Private Sub cmdSelectAll_Click()
Call SelectAll
End Sub

Private Sub cmdRemoveClientData_Click()
On Error GoTo ErrorHandler
DoCmd.Hourglass True
' ******************************************************************
' Initialize Variables And Arrays
' ******************************************************************
Set db = CurrentDb()
Call LoadEEIDTableNames
Call LoadClientIDTableNames
Call LoadClientPlanTableNames
Call LoadPlanTableNames
Call LoadTrustTableNames
Call LoadWorkingTableNames

' ******************************************************************
' Determine if All or Selected Purge Was Requested
' ******************************************************************
If Me.frameSelectOptions = 2 Then
    lngResponse = MsgBox("WARNING!!!  Are You Sure You Want To Remove All Client Data?", vbYesNo)
    If lngResponse = vbNo Then
        MsgBox ("Client Data Not Removed")
        DoCmd.Hourglass False
        Exit Sub
    End If
    Call SelectAll
End If
' ******************************************************************
' Loop Through Purge Selections
' ******************************************************************
If Me.lstClientsSelected.ItemsSelected.count = 0 Then
    MsgBox ("You Must Select At Least 1 Client To Be Removed")
    DoCmd.Hourglass False
    Exit Sub
End If

With Me.lstClientsSelected
    For Each varSelectedClientID In .ItemsSelected
        If Not IsNull(varSelectedClientID) Then
            lngClientIDToBePurged = .ItemData(varSelectedClientID)
            lngResponse = MsgBox("Are You Sure You Want To Remove " & _
                Me.lstClientsSelected.Column(0, varSelectedClientID) & "?", vbYesNo)
            If lngResponse = vbYes Then
' ******************************************************************
' Step 1: Build The EEID Array
' ******************************************************************
                Call BuildEEIDArray
                If lngEEIDCount > 0 Then
' ******************************************************************
' Step 1A: Extract PersonIDs From EmployeeData
' ******************************************************************
                    Call BuildPersonArray
' ******************************************************************
' Step 2: Delete Records Matching To EEIDs from Step 1
' ******************************************************************
                    Call RemoveEEIDClientRecords
' ******************************************************************
' Step 2A: Remove Records Matching to PersonIDs From Step 1A
' ******************************************************************
                    Call RemoveRecordsFromPersonTable
                End If
' ******************************************************************
' Step 3: Extract ClientPlanIDs
' ******************************************************************
                Call BuildClientPlanIDArray
                If lngClientPlanCount <> 0 Then
' ******************************************************************
' Step 4: Remove Records Matching to ClientPlanIDs from Step 3
' ******************************************************************
                    Call RemoveRecordsFromClientPlanTables
                End If
' ******************************************************************
' Step 5: Extract Unique PlanIDs from Table ClientData
' ******************************************************************
                Call BuildPlanIDArray
' ******************************************************************
' Step 6: Extract Unique TrustIDs from Table Plans
'         For Matching PlanIDs from Step 5
' ******************************************************************
                Call BuildTrustIDArray
' ******************************************************************
' Step 7: Remove ClientTrustID Matches from many tables
' ******************************************************************
                RemoveClientTransIDRecords
' ******************************************************************
' Step 7A: Remove ClientTrustID Matches From ClientData Table
' ******************************************************************
                RemoveClientDataClientTransID
' ******************************************************************
' Step 8: Conditionally Remove PlanIDs From Multiple Tables
' ******************************************************************
                RemovePlanIDs
' ******************************************************************
' Step 9: Conditionally Remove TrustIDs From Multiple Tables
' ******************************************************************
                RemoveTrustIDs
' ******************************************************************
' Step 10: Clear Working Tables
' ******************************************************************
                RemoveWorkingTableRecords
            End If
        End If
    Next
End With
MsgBox ("Record Removal Complete")
DoCmd.Hourglass False
DoCmd.Close
Exit Sub

' ******************************************************************
' Error Handler For The Main Procedure
' ******************************************************************
ErrorHandler:
strProcName = "cmdRemoveClientData_Click"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub ClearAll()
' ******************************************************************
' Clear All Selections In The List Box
' ******************************************************************
Dim varClientID As Variant
For Each varClientID In Me.lstClientsSelected.ItemsSelected
    Me.lstClientsSelected.Selected(varClientID) = False
Next
End Sub

Private Sub SelectAll()
' ******************************************************************
' Select All Rows in the List Box
' ******************************************************************
Dim lngRow As Long
For lngRow = 0 To Me.lstClientsSelected.ListCount - 1
    Me.lstClientsSelected.Selected(lngRow) = True
Next
End Sub

Private Sub LoadEEIDTableNames()
' ******************************************************************
' Load The Table Names for EEID Record Removals
' ******************************************************************
strEEIDTablesToPurge(1) = "DeletedEE_ACAEvents"
strEEIDTablesToPurge(2) = "Distributions2000"
strEEIDTablesToPurge(3) = "EE_ACACoverageStatus"
strEEIDTablesToPurge(4) = "EE_ACACoverageStatusHistory"
strEEIDTablesToPurge(5) = "EE_ACAEvents"
strEEIDTablesToPurge(6) = "EEACABenefitSelection"
strEEIDTablesToPurge(7) = "EEACAPayrollType"
strEEIDTablesToPurge(8) = "EEAddresses"
strEEIDTablesToPurge(9) = "EEAddressesHist"
strEEIDTablesToPurge(10) = "EEChangeHistory"
strEEIDTablesToPurge(11) = "EECoverageStatusByONeCoverageDate"
strEEIDTablesToPurge(12) = "EEHardships"
strEEIDTablesToPurge(13) = "EEInvElections"
strEEIDTablesToPurge(14) = "EEInvErrs"
strEEIDTablesToPurge(15) = "EEInvest"
strEEIDTablesToPurge(16) = "EEInvestOld"
strEEIDTablesToPurge(17) = "EEInvestOrphans"
strEEIDTablesToPurge(18) = "EELoanPayments"
strEEIDTablesToPurge(19) = "EELoans"
strEEIDTablesToPurge(20) = "EEsELEntry"
strEEIDTablesToPurge(21) = "EETable"
strEEIDTablesToPurge(22) = "EligACAData"
strEEIDTablesToPurge(23) = "meaEEDataEntry"
strEEIDTablesToPurge(24) = "missingEEs"
strEEIDTablesToPurge(25) = "ORIAmerAcctNum"
strEEIDTablesToPurge(26) = "ORICalvertAcctNum"
strEEIDTablesToPurge(27) = "ORIValicAcctNum"
strEEIDTablesToPurge(28) = "PayrollData"
strEEIDTablesToPurge(29) = "PRSplits"
strEEIDTablesToPurge(30) = "zlog_EEHardships"
strEEIDTablesToPurge(31) = "zlog_EELoans"
strEEIDTablesToPurge(32) = "EmployeeData"
End Sub

Private Sub LoadClientIDTableNames()
' ******************************************************************
' Load The Table Names for ClientTransID Removals
' ******************************************************************
strClientIDTablesToPurge(1, 1) = "ACABenefitPremiums"
strClientIDTablesToPurge(2, 1) = "AffiliatedGroupMember"
strClientIDTablesToPurge(3, 1) = "ClientACAConfig"
strClientIDTablesToPurge(4, 1) = "ClientACAConfigHistory"
strClientIDTablesToPurge(5, 1) = "ClientACAPayrollType"
strClientIDTablesToPurge(6, 1) = "ClientACAStdPeriodDates"
strClientIDTablesToPurge(7, 1) = "ClientCustomImportFields"
strClientIDTablesToPurge(8, 1) = "ClientInvest"
strClientIDTablesToPurge(9, 1) = "DeletedEE_ACAEvents"
strClientIDTablesToPurge(10, 1) = "CLRpts"
strClientIDTablesToPurge(11, 1) = "Correspondence"
strClientIDTablesToPurge(12, 1) = "DMClientData"
strClientIDTablesToPurge(13, 1) = "EE_ACACoverageStatus"
strClientIDTablesToPurge(14, 1) = "EE_ACACoverageStatusHistory"
strClientIDTablesToPurge(15, 1) = "EE_ACAEvents"
strClientIDTablesToPurge(16, 1) = "EEACABenefitSelection"
strClientIDTablesToPurge(17, 1) = "EEACAPayrollType"
strClientIDTablesToPurge(18, 1) = "EEAddresses"
strClientIDTablesToPurge(19, 1) = "EEAddressesHist"
strClientIDTablesToPurge(20, 1) = "EECoverageStatusByOneCoverageDate"
strClientIDTablesToPurge(21, 1) = "EELoanPayments"
strClientIDTablesToPurge(22, 1) = "EligACAData"
strClientIDTablesToPurge(23, 1) = "EligACAProcess"
strClientIDTablesToPurge(24, 1) = "EligACAProcessNewFromIMPPTDData"
strClientIDTablesToPurge(25, 1) = "EligChk"
strClientIDTablesToPurge(26, 1) = "EligTemp"
strClientIDTablesToPurge(27, 1) = "ERDepts"
strClientIDTablesToPurge(28, 1) = "ErrorLog"
strClientIDTablesToPurge(29, 1) = "ErrorLogHistory"
strClientIDTablesToPurge(30, 1) = "ImportHistory"
strClientIDTablesToPurge(31, 1) = "Issues"
strClientIDTablesToPurge(32, 1) = "ManuLifeMaps"
strClientIDTablesToPurge(33, 1) = "PayrollDataACA"
strClientIDTablesToPurge(34, 1) = "PayrollDataACAMMM"
strClientIDTablesToPurge(35, 1) = "PRIssues"
strClientIDTablesToPurge(36, 1) = "PRPRocess"
strClientIDTablesToPurge(37, 1) = "PRProcessHistory"
strClientIDTablesToPurge(38, 1) = "PRStatus"
strClientIDTablesToPurge(39, 1) = "PRStatusBoard"
strClientIDTablesToPurge(40, 1) = "zlog_PayrollPDFReports"

' ******************************************************************
' Load The Key Names For The Above 40 Tables Since Names Vary
' ******************************************************************
strClientIDTablesToPurge(1, 2) = "ClientID"
strClientIDTablesToPurge(2, 2) = "ClientTransID"
strClientIDTablesToPurge(3, 2) = "ClientTransID"
strClientIDTablesToPurge(4, 2) = "ClientTransID"
strClientIDTablesToPurge(5, 2) = "ClientID"
strClientIDTablesToPurge(6, 2) = "ClientTransID"
strClientIDTablesToPurge(7, 2) = "ClientTransID"
strClientIDTablesToPurge(8, 2) = "ClientTransID"
strClientIDTablesToPurge(9, 2) = "ClientTransID"
strClientIDTablesToPurge(10, 2) = "ClientTransID"
strClientIDTablesToPurge(11, 2) = "ClientTransID"
strClientIDTablesToPurge(12, 2) = "ClientTransID"
strClientIDTablesToPurge(13, 2) = "ClientTransID"
strClientIDTablesToPurge(14, 2) = "ClientTransID"
strClientIDTablesToPurge(15, 2) = "ClientTransID"
strClientIDTablesToPurge(16, 2) = "ClientID"
strClientIDTablesToPurge(17, 2) = "ClientID"
strClientIDTablesToPurge(18, 2) = "ClientID"
strClientIDTablesToPurge(19, 2) = "ClientID"
strClientIDTablesToPurge(20, 2) = "ClientID"
strClientIDTablesToPurge(21, 2) = "ClientID"
strClientIDTablesToPurge(22, 2) = "ClientID"
strClientIDTablesToPurge(23, 2) = "ClientID"
strClientIDTablesToPurge(24, 2) = "ClientID"
strClientIDTablesToPurge(25, 2) = "ClientTransID"
strClientIDTablesToPurge(26, 2) = "ClientID"
strClientIDTablesToPurge(27, 2) = "ClientTransID"
strClientIDTablesToPurge(28, 2) = "lClientTransID"
strClientIDTablesToPurge(29, 2) = "lClientTransID"
strClientIDTablesToPurge(30, 2) = "ClientTransID"
strClientIDTablesToPurge(31, 2) = "ClientTransID"
strClientIDTablesToPurge(32, 2) = "ClientTransID"
strClientIDTablesToPurge(33, 2) = "ClientID"
strClientIDTablesToPurge(34, 2) = "ClientID"
strClientIDTablesToPurge(35, 2) = "ClientTransID"
strClientIDTablesToPurge(36, 2) = "ClientTransID"
strClientIDTablesToPurge(37, 2) = "ClientTransID"
strClientIDTablesToPurge(38, 2) = "ClientTransID"
strClientIDTablesToPurge(39, 2) = "ClientTransID"
strClientIDTablesToPurge(40, 2) = "ClientID"
End Sub

Private Sub LoadClientPlanTableNames()
strClientPlanTablesToPurge(1) = "CLPMSources"
strClientPlanTablesToPurge(2) = "ER1CalcSpecs"
strClientPlanTablesToPurge(3) = "ClientPlans"
End Sub

Private Sub LoadPlanTableNames()
strPlanTables(1) = "Distributions"
strPlanTables(2) = "PlanInvAccounts"
strPlanTables(3) = "Plans"
End Sub

Private Sub LoadTrustTableNames()
strTrustTables(1) = "TrustAddrs"
strTrustTables(2) = "Trusts"
End Sub

Private Sub LoadWorkingTableNames()
' ******************************************************************
' Load The Table Names for Temporary Tables
' ******************************************************************
strWorkingTableName(1) = "EWEBYTD"
strWorkingTableName(2) = "[Import Table]"
strWorkingTableName(3) = "ImportRawUPTo40Fields"
strWorkingTableName(4) = "ImportRawUpTo80Fields"
strWorkingTableName(5) = "PayrollDataToExport"
strWorkingTableName(6) = "PayrollResults"
strWorkingTableName(7) = "Plan_Contacts"
strWorkingTableName(8) = "PlanStaff"
strWorkingTableName(9) = "PRDataACES"
strWorkingTableName(10) = "REhireTableForReport"
strWorkingTableName(11) = "UnmatchedPersons"
strWorkingTableName(12) = "zlog_DataChanges"
End Sub

Private Sub BuildEEIDArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 1 - Build The EEID Array
' ******************************************************************
lngEEIDCount = 0
' ******************************************************************
' Query AllEEsByClientID:
' This Is The Same Query As AllEEsByClientID Except It Has a Where
' Clause To Select Only One Matching Client from the List Box
' ******************************************************************
strSQLListEmployees = "SELECT ClientData.ClientTransID, ClientData.ClientName, ClientPlans.ClientPlanID, " & _
"ClientPlans.ClientPlanCode, EmployeeData.EEID, EmployeeData.SSN, EmployeeData.Dept, EmployeeData.LastName, " & _
"EmployeeData.FirstName, EmployeeData.DOB, EmployeeData.DOH, EmployeeData.DOT " & _
"FROM (ClientData INNER JOIN ClientPlans ON ClientData.ClientTransID=ClientPlans.ClientTransID) " & _
"INNER JOIN EmployeeData ON ClientPlans.ClientPlanID=EmployeeData.ClientPlanID " & _
"WHERE ClientData.ClientTransID=" & lngClientIDToBePurged & ";"

Set recIn = db.OpenRecordset(strSQLListEmployees)

' ******************************************************************
' Loop Through All EEID Records Matching To the Selected Client
' And Add Them To The Array
' ******************************************************************
If Not recIn.EOF Then
    Do
        lngEEIDCount = lngEEIDCount + 1
        ReDim Preserve lngEEIDKeyValues(1 To lngEEIDCount)
        lngEEIDKeyValues(lngEEIDCount) = recIn!EEID
        recIn.MoveNext
    Loop Until recIn.EOF
    recIn.Close
    Set recIn = Nothing
End If
Exit Sub

' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildEEIDArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub BuildPersonArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 1A - Build The Person Array
' ******************************************************************
lngPersonCount = 0
' ******************************************************************
' DLookup To Create Person IDs for Each EEID In The Array
' ******************************************************************
For lngEEIDKeyIndex = LBound(lngEEIDKeyValues) To UBound(lngEEIDKeyValues)
    varPersonID = DLookup("[PersonID]", "EmployeeData", "[EEID] = " & lngEEIDKeyValues(lngEEIDKeyIndex))
    If Not IsNull(varPersonID) And varPersonID <> 0 Then
        lngPersonCount = lngPersonCount + 1
        ReDim Preserve lngPersonKeyValues(1 To lngPersonCount)
        lngPersonKeyValues(lngPersonCount) = varPersonID
    End If
Next lngEEIDKeyIndex
Exit Sub

' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildPersonArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub RemoveEEIDClientRecords()
' ******************************************************************
' STEP 2
' Delete The Employee Records whose EEID Codes
' Are Associated With The Selected Client to Remove
' ******************************************************************
On Error GoTo ErrorHandler
For lngEEIDTableIndex = 1 To 32
    For lngEEIDKeyIndex = LBound(lngEEIDKeyValues) To UBound(lngEEIDKeyValues)
' ******************************************************************
' Set Up The EEID Delete Query And Cycle Through All The Tables
' For All The Employees Associated with the Client to Be Removed
' ******************************************************************
        strSQL_EEIDRemoval = "DELETE " & strEEIDTablesToPurge(lngEEIDTableIndex) & _
        ".EEID FROM " & strEEIDTablesToPurge(lngEEIDTableIndex) & " WHERE " & _
        strEEIDTablesToPurge(lngEEIDTableIndex) & ".EEID=" & lngEEIDKeyValues(lngEEIDKeyIndex) & ";"
        
        db.Execute strSQL_EEIDRemoval, dbFailOnError
        
    Next lngEEIDKeyIndex
Next lngEEIDTableIndex
Exit Sub

' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveEEIDClientRecords - Table: " & strEEIDTablesToPurge(lngEEIDTableIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub RemoveRecordsFromPersonTable()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 2A
' Remove Persons From PersonData If No Longer Referenced
' In The EmployeeData Table
' ******************************************************************
' ******************************************************************
' If No Persons Were Encountered in the EmployeeData Table
' Skip This Process
' ******************************************************************
If lngPersonCount = 0 Then
    Exit Sub
End If

For lngPersonIDKeyIndex = LBound(lngPersonKeyValues) To UBound(lngPersonKeyValues)
' ******************************************************************
' See if the PersonID Still Exists in the EmployeeData Table
' If an EEID still Exists For a PersonID, Then Don't Delete the
' Person
' ******************************************************************
    varEEID = DLookup("[EEID]", "EmployeeData", "[PersonId] = " & lngPersonKeyValues(lngPersonIDKeyIndex))
    If IsNull(varEEID) Then
        strSQLDeletePersonData = "DELETE PersonData.PersonID FROM PersonData WHERE PersonData.PersonID=" & _
        lngPersonKeyValues(lngPersonIDKeyIndex) & ";"
        db.Execute strSQLDeletePersonData, dbFailOnError
    End If
        
Next lngPersonIDKeyIndex
Exit Sub

' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveRecordsFromPersonTable: PersonData"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub BuildClientPlanIDArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 3 - Build The Client Plan Array
' ******************************************************************
lngClientPlanCount = 0
' ******************************************************************
' Extract All ClientPlanIDs from the ClientPlan Table
' That Have Records That Match to the List Box ClientTransID
' ******************************************************************
strSQLExtractClientPlanIDs = "SELECT ClientPlans.ClientPlanID FROM ClientPlans " & _
"WHERE ClientPlans.ClientTransID=" & lngClientIDToBePurged & ";"

Set recIn = db.OpenRecordset(strSQLExtractClientPlanIDs)

' ******************************************************************
' Loop Through All Matching Records And Save The ClientPlanID
' Into The Array
' ******************************************************************
If Not recIn.EOF Then
    Do
        lngClientPlanCount = lngClientPlanCount + 1
        ReDim Preserve lngClientPlanIDKeyValues(1 To lngClientPlanCount)
        lngClientPlanIDKeyValues(lngClientPlanCount) = recIn!ClientPlanID
        recIn.MoveNext
    Loop Until recIn.EOF
    recIn.Close
    Set recIn = Nothing
End If
Exit Sub

' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildClientPlanIDArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub RemoveRecordsFromClientPlanTables()
' ******************************************************************
' STEP 4 - Remove ClientPlanID Records Matching To
'          ClientPlanIDs extracted in Step 3
' ******************************************************************
On Error GoTo ErrorHandler
For lngClientPlanTableIndex = 1 To 3
    For lngClientPlanKeyIndex = LBound(lngClientPlanIDKeyValues) To UBound(lngClientPlanIDKeyValues)
' ******************************************************************
' Set Up The ClientPlan Delete Query And Cycle Through All The Tables
' That Use ClientPlanID
' ******************************************************************
        strSQLClientPlanIDRemoval = "DELETE " & strClientPlanTablesToPurge(lngClientPlanTableIndex) & _
        ".ClientPlanID FROM " & strClientPlanTablesToPurge(lngClientPlanTableIndex) & " WHERE " & _
        strClientPlanTablesToPurge(lngClientPlanTableIndex) & ".ClientPlanID=" & lngClientPlanIDKeyValues(lngClientPlanKeyIndex) & ";"
        
        db.Execute strSQLClientPlanIDRemoval, dbFailOnError
        
    Next lngClientPlanKeyIndex
Next lngClientPlanTableIndex
Exit Sub

' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveRecordsFromClientPlanTables - Table: " & strClientPlanTablesToPurge(lngClientPlanTableIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub
Private Sub BuildPlanIDArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 5 - Build The PlanID Array
' ******************************************************************
lngPlanCount = 0
' ******************************************************************
' Extract All Distinct PlanIDs from the ClientData Table
' That Have Records That Match to the List Box ClientTransID
' ******************************************************************
strSQLExtractPlanIDs = "SELECT Distinct ClientData.PlanID FROM ClientData " & _
"WHERE ClientData.ClientTransID=" & lngClientIDToBePurged & ";"

Set recIn = db.OpenRecordset(strSQLExtractPlanIDs)

' ******************************************************************
' Loop Through All Matching Records And Save The PlanID
' Into The Array
' ******************************************************************
If Not recIn.EOF Then
    Do
        lngPlanCount = lngPlanCount + 1
        ReDim Preserve lngPlanIDKeyValues(1 To lngPlanCount)
        lngPlanIDKeyValues(lngPlanCount) = recIn!PlanID
        recIn.MoveNext
    Loop Until recIn.EOF
    recIn.Close
    Set recIn = Nothing
End If

Exit Sub
' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildPlanIDArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next


End Sub

Private Sub BuildTrustIDArray()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 6 - Build The TrustID Array
' ******************************************************************
lngTrustCount = 0
' ******************************************************************
' Extract All Distinct TrustIDs from the Plans Table
' That Have Records That Match to the PlanIDs Array From Step 5
' ******************************************************************
For lngPlanIDIndex = LBound(lngPlanIDKeyValues) To UBound(lngPlanIDKeyValues)

    strSQLExtractTrustIDs = "SELECT Distinct Plans.TrustID FROM Plans " & _
    "WHERE Plans.PlanID=" & lngPlanIDKeyValues(lngPlanIDIndex) & ";"

    Set recIn = db.OpenRecordset(strSQLExtractTrustIDs)

' ******************************************************************
' Loop Through All Matching Records And Save The TrustID
' Into The Array
' ******************************************************************
If Not recIn.EOF Then
    Do
        lngTrustCount = lngTrustCount + 1
        ReDim Preserve lngTrustIDKeyValues(1 To lngTrustCount)
        lngTrustIDKeyValues(lngTrustCount) = recIn!trustID
        recIn.MoveNext
    Loop Until recIn.EOF
    recIn.Close
    Set recIn = Nothing
End If
Next lngPlanIDIndex
Exit Sub

' ******************************************************************
' Error Handler
' ******************************************************************
ErrorHandler:
strProcName = "BuildTrustIDArray"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub RemoveClientTransIDRecords()
' ******************************************************************
' STEP 7
' Remove Records in Numerous tables That Match to the ClientTransID
' Currently Being Processed from the List Box
' ******************************************************************
On Error GoTo ErrorHandler
For lngClientTransIDTableIndex = 1 To 40
' ******************************************************************
' Set Up The ClientTransID Delete Query And Cycle Through All The Tables
' For All The Records Associated with the Client to Be Removed
' ******************************************************************
    strSQL_ClientTransIDRemoval = "DELETE " & _
    strClientIDTablesToPurge(lngClientTransIDTableIndex, 1) & "." & strClientIDTablesToPurge(lngClientTransIDTableIndex, 2) & _
    " FROM " & strClientIDTablesToPurge(lngClientTransIDTableIndex, 1) & _
    " WHERE " & strClientIDTablesToPurge(lngClientTransIDTableIndex, 1) & "." & strClientIDTablesToPurge(lngClientTransIDTableIndex, 2) & _
    "=" & lngClientIDToBePurged & ";"
    
    db.Execute strSQL_ClientTransIDRemoval, dbFailOnError
        
Next lngClientTransIDTableIndex
Exit Sub

' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveClientTransIDRecords - Table: " & strClientIDTablesToPurge(lngClientTransIDTableIndex, 1)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub RemoveClientDataClientTransID()
' ******************************************************************
' STEP 7A
' Remove Records in the ClientData table
' Currently Being Processed from the List Box
' ******************************************************************
On Error GoTo ErrorHandler
' ******************************************************************
' Set Up The Delete Query And Cycle Through All The Tables
' For All The ClientTransIDs Associated with the Client to Be Removed
' ******************************************************************
strSQL_ClientData_ClientTransIDRemoval = "DELETE ClientData.ClientTransID FROM ClientData " & _
" WHERE ClientData.ClientTransID=" & lngClientIDToBePurged & ";"
    
db.Execute strSQL_ClientData_ClientTransIDRemoval, dbFailOnError
Exit Sub

' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveClientTransIDRecords - Table: ClientData"
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub RemovePlanIDs()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 8
' Remove PlanIDs from Multiple Tables
' That Match PlanID
' ******************************************************************
' ******************************************************************
' If No Plans Were Entered in the PlanID Table
' Skip This Process
' ******************************************************************
If lngPlanCount = 0 Then
    Exit Sub
End If

' ******************************************************************
' Search In ClientData For Each PlanID In The PlanID Array
' ******************************************************************
For lngPlanIDIndex = LBound(lngPlanIDKeyValues) To UBound(lngPlanIDKeyValues)

' ******************************************************************
' Determine if the PlanID Still Exists in the ClientData Table
' If Yes, then skip the deletes below
' If No, then remove the Plan ID from 3 tables
' ******************************************************************
    varClientTransID = DLookup("[ClientTransID]", "ClientData", "[PlanID] = " & lngPlanIDKeyValues(lngPlanIDIndex))
    If IsNull(varClientTransID) Then
        For lngPlanTableIndex = 1 To 3
            strSQLPlanIDRemoval = "DELETE " & strPlanTables(lngPlanTableIndex) & ".PlanId" & _
            " FROM " & strPlanTables(lngPlanTableIndex) & " WHERE " & strPlanTables(lngPlanTableIndex) & ".PlanId=" & _
            lngPlanIDKeyValues(lngPlanIDIndex) & ";"
            
            db.Execute strSQLPlanIDRemoval, dbFailOnError
        Next lngPlanTableIndex
    End If
Next lngPlanIDIndex
Exit Sub

' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemovePlanIDs - Table: " & strPlanTables(lngPlanTableIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub RemoveTrustIDs()
On Error GoTo ErrorHandler
' ******************************************************************
' STEP 9
' Remove TrustIDs from Multiple Tables
' That Match TrustIDs Saved In Array
' ******************************************************************
' ******************************************************************
' If No Trusts Were Entered in the TrustID Table
' Skip This Process
' ******************************************************************
If lngTrustCount = 0 Then
    Exit Sub
End If

' ******************************************************************
' Search In Plans Table For Each TrustID In The TrustID Array
' ******************************************************************
For lngTrustIDIndex = LBound(lngTrustIDKeyValues) To UBound(lngTrustIDKeyValues)

' ******************************************************************
' Determine if the TrustID Still Exists in the Plans Table
' If Yes, then skip the deletes below
' If No, then remove the TrustID from 2 tables
' ******************************************************************
    varPlanID = DLookup("[PlanID]", "Plans", "[TrustID] = " & lngTrustIDKeyValues(lngTrustIDIndex))
    If IsNull(varPlanID) Then
        For lngTrustTableIndex = 1 To 2
            strSQLTrustIDRemoval = "DELETE " & strTrustTables(lngTrustTableIndex) & ".TrustId" & _
            " FROM " & strTrustTables(lngTrustTableIndex) & " WHERE " & strTrustTables(lngTrustTableIndex) & ".TrustId=" & _
            lngTrustIDKeyValues(lngTrustIDIndex) & ";"
            
            db.Execute strSQLTrustIDRemoval, dbFailOnError
        Next lngTrustTableIndex
    End If
Next lngTrustIDIndex
Exit Sub

' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveTrustIDs - Table: " & strTrustTables(lngTrustTableIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub

Private Sub RemoveWorkingTableRecords()
' ******************************************************************
' STEP 10
' Clear All Rows In Working Tables
' ******************************************************************
On Error GoTo ErrorHandler
For lngWorkingTableNameIndex = 1 To 10
    strSQLDeleteWorkingTableRows = "DELETE " & strWorkingTableName(lngWorkingTableNameIndex) & ".* " & _
    "FROM " & strWorkingTableName(lngWorkingTableNameIndex) & ";"
    
    db.Execute strSQLDeleteWorkingTableRows, dbFailOnError
    
Next lngWorkingTableNameIndex
Exit Sub

' ******************************************************************
' Error Handler That Includes Table Names
' ******************************************************************
ErrorHandler:
strProcName = "RemoveWorkingTableRecords - Table: " & strWorkingTableName(lngWorkingTableNameIndex)
strErrorDescription = Err.Description
lngErrNumber = Err.Number
DoCmd.Hourglass False

HandleError strProcName, strErrorDescription, lngErrNumber
Err.Clear
Resume Next

End Sub