asked on
VBA to match Header regardless of order

I have the following code that works just fine. The issue I am having is that I am spending more time adjusting the order of the columns in the spreadsheet than anything.. I run this multiple times a day. Is there a way to just match the header, regardless of the order they are in on the sheet? Thank you in advance for the help.
Option Compare Binary
'Delete existing input and error tables
Sub delTable()
Debug.Print Now() & " " & "Delete Tables"
On Error Resume Next
DoCmd.Close acTable, ("tbl_errors")
DoCmd.Close acTable, ("tbl_input")
DoCmd.DeleteObject acTable, "tbl_input"
DoCmd.DeleteObject acTable, "tbl_errors"
DoCmd.DeleteObject acTable, "input$_ImportErrors"
On Error GoTo 0
End Sub
'Import sheet from specified location
Sub importSheet()
Run "delTable"
Debug.Print Now() & " " & "Import Sheet"

'Import Sheet based on saved import.
DoCmd.RunSavedImportExport "tbl_inputa"

'Create blank error table.
Run "createErrorTable"
Debug.Print Now() & " " & "Import Complete"
End Sub

'Creates tbl_errors if it doesn't exist.

Sub createErrorTable()
Debug.Print Now() & " " & "Create Error Table"
'Check to see if error table exists.
Dim SQL As String
    SQL = "CREATE TABLE tbl_errors (ID text, NPI text, Field text, MSG text)"
    DoCmd.RunSQL (SQL)
End Sub


'Check sheet for null or duplicate ID in each row.
Sub checkNullID()
Debug.Print Now() & " " & "Check ID for Null and Duplicate"
    Dim SQL As String
    SQL = "Insert into tbl_errors (ID, NPI, Field, MSG) Select ID, NPI, 'ID' as Field, (LastName + ', ' + FirstName + ' - Missing ID') as MSG from tbl_input where ID is null "
    DoCmd.RunSQL (SQL)
'Check for duplicate ID
    SQL = "Insert into tbl_errors (ID, NPI, Field, MSG) Select ID, MIN(NPI), 'ID', 'Duplicate ID' from tbl_input group by ID having (count(ID) > 1) order by ID"
    DoCmd.RunSQL (SQL)
End Sub

'Check for duplicate records (Using SSN and Address fields)
Sub checkDupRec2()
Debug.Print Now() & " " & "Check for Duplicate Records"
    Dim SQL As String
    SQL = "Insert into tbl_errors (ID, NPI, Field, MSG) " & _
            "Select ID, NPI, 'ALL', 'Duplicate Record' " & _
            "FROM tbl_input AS a " & _
            "WHERE 1 < (SELECT Count(1) " & _
            "FROM tbl_input AS b " & _
            "WHERE b.SSN = a.SSN " & _
            "AND b.ADDRLINE1 = a.ADDRLINE1 " & _
            "AND b.CITY = a.CITY " & _
            "AND b.ZIPCODE = a.ZIPCODE " & _
            "AND b.PHONE = a.PHONE " & _
            "AND b.TIN = a.TIN " & _
            "AND b.NPI = a.NPI " & _
            "AND b.GROUPNPI = a.GROUPNPI) "
          
    'DoCmd.RunSQL (SQL)

End Sub
'Check for duplicate records (Using REQ fields)
Sub checkDupRec()
DoCmd.SetWarnings False
Debug.Print Now() & " " & "Check for Duplicate Records"
    Dim i As Integer
    Dim SQL As String
    Dim strReqFields As Variant
    strReqFields = Array("SSN", "LASTNAME", "FIRSTNAME", "DEGREE", "DATEOFBIRTH", "GENDER", "LANGUAGE1", "PLAN", "DELEGATESTATUS", _
    "DELEGATE", "NETWORK", "START_DATE", "END_DATE", "SPECIALTY", "PCP", "BOARDCERTIFIED", "TAXONOMY", "LICENSENUM", "LICENSEEXPDATE", _
    "LICENSESTATE", "CREDSTARTDATE", "TIN", "NPI", "PROVIDER_TYPE", "ADDRLINE1", "ADDRLINE2", "CITY", "STATE", "ZIPCODE", "PHONE", "BILLINGADDRLINE1", _
    "BILLINGCITY", "BILLINGSTATE", "BILLINGZIPCODE", "BILLINGPHONE", "INSURANCECARRIER", "INSURANCEEXPDATE", "INSURANCEAMOUNT", _
    "COMMITTEEAPPROVALDATE")
    SQL = "Insert into tbl_errors (ID, NPI, Field, MSG) " & _
            "Select ID, NPI, 'ALL', 'Duplicate Record' " & _
            "FROM tbl_input AS a " & _
            "WHERE 1 < (SELECT Count(1) " & _
            "FROM tbl_input AS b " & _
            "WHERE 1=1 "
    For i = 0 To UBound(strReqFields, 1)
    SQL = SQL & " AND b." & strReqFields(i) & " = a." & strReqFields(i)
    Next i
    SQL = SQL & ")"
    'Debug.Print Now() & " " & SQL
    DoCmd.RunSQL (SQL)
End Sub

'Find values that don't match a corresponding value in Portico
Sub checkMappedValues()
Debug.Print Now() & " " & "Check Mapped Values"
DoCmd.SetWarnings False
Dim SQL As String

'NPI
Debug.Print Now() & " " & "NPI"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select TI.ID, TI.NPI, 'NPI: ' + TI.NPI, 'NPI Exists in Portico' " & _
            "from tbl_input TI " & _
            "Inner Join PORTOWN_V_UDA_PRAC_NPI NPI " & _
            "ON Clng(TI.NPI) = NPI.NUMBER_UDA " & _
            "where NPI.NUMBER_UDA is not null"
            
DoCmd.RunSQL (SQL)


'Degree

    SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI,'DEGREE: ' + DEGREE, 'Does not map to Degree in Portico' " & _
            "from tbl_input " & _
            "where DEGREE NOT IN (Select CODE from PORTOWN_FMG_CODES FC where TYPE = 'MEDICAL_DEGREE') " & _
            " order by ID"
    DoCmd.RunSQL (SQL)
    
'Languages
    SQL = "Insert into tbl_errors (ID, NPI,FIELD, MSG) " & _
            "Select ID, NPI, 'Language1: ' + LANGUAGE1, 'Does not map to Language in Portico' " & _
            "from tbl_input " & _
            "where Language1 <> '' and Language1 NOT IN (Select CODE from PORTOWN_FMG_CODES FC where FC.TYPE = 'LANGUAGE') " & _
            " order by ID"
    DoCmd.RunSQL (SQL)

     SQL = "Insert into tbl_errors (ID, NPI,FIELD, MSG) " & _
            "Select ID, NPI,'Language2: ' + LANGUAGE2, 'Does not map to Language in Portico' " & _
            "from tbl_input " & _
            "where Language2 <> '' and Language2 NOT IN (Select CODE from PORTOWN_FMG_CODES FC where FC.TYPE = 'LANGUAGE') " & _
            " order by ID"
    DoCmd.RunSQL (SQL)
    
     SQL = "Insert into tbl_errors (ID, NPI,FIELD, MSG) " & _
            "Select ID, NPI, 'Language3: ' + LANGUAGE3, 'Does not map to Language in Portico' " & _
            "from tbl_input " & _
            "where Language3 <> '' and Language3 NOT IN (Select CODE from PORTOWN_FMG_CODES FC where FC.TYPE = 'LANGUAGE') " & _
            " order by ID"
    DoCmd.RunSQL (SQL)
'Delegate
    SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Delegate: ' + DELEGATE, 'Does not map to Delegate in Portico' " & _
            "from tbl_input " & _
            "where DELEGATE NOT IN (Select DS from PORTOWN_FMG_CODES FC where TYPE = 'AFFILIATED_AGENCY') " & _
            " order by ID"
    DoCmd.RunSQL (SQL)
    
'Board Certified
SQL = "Insert into tbl_errors (ID, NPI,FIELD, MSG) " & _
            "Select ID, NPI,'Board Certified: ' + BOARDCERTIFIED, 'Does not map to Board Status in Portico' " & _
            "from tbl_input " & _
            "where BOARDCERTIFIED NOT IN (Select DS from PORTOWN_FMG_CODES FC where TYPE = 'BOARD_STATUS') " & _
            " order by ID"
    DoCmd.RunSQL (SQL)

'Insurance Carrier
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Insurance Carrier: ' + INSURANCECARRIER, 'Does not map to Insurance Carrier in Portico' " & _
            "from tbl_input " & _
            "where INSURANCECARRIER NOT IN (Select DS from PORTOWN_FMG_CODES FC where TYPE = 'INSURANCE_CARRIER') " & _
            " order by ID"
    DoCmd.RunSQL (SQL)

'Medical School (Case Sensitive)
Debug.Print Now() & " " & "Medical School"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select TI.ID, TI.NPI, 'Medical School: ' + TI.MEDICALSCHOOL, 'Does not map to Institution in Portico' " & _
            "from tbl_input TI " & _
            "Left Outer Join PORTOWN_PC_TRAINING PCT " & _
            "ON STRCOMP(TI.MEDICALSCHOOL, PCT.NAME,0)=0 " & _
            "where PCT.NAME is NULL " & _
            "and MEDICALSCHOOL <> '' and MEDICALSCHOOL is not null " & _
            "order by TI.ID"
    DoCmd.RunSQL (SQL)
    
    
Debug.Print Now() & " " & "Residency"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select TI.ID, TI.NPI, 'Residency: ' + TI.RESIDENCY, 'Does not map to Institution in Portico' " & _
            "from tbl_input TI " & _
            "Left Outer Join PORTOWN_PC_TRAINING PCT " & _
            "ON STRCOMP(TI.RESIDENCY, PCT.NAME,0)=0 " & _
            "where PCT.NAME is NULL " & _
            "and RESIDENCY <> '' and RESIDENCY is not null " & _
            "order by TI.ID"
    DoCmd.RunSQL (SQL)


'Internship
Debug.Print Now() & " " & "Internship"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select TI.ID, TI.NPI, 'Internship: ' + TI.INTERNSHIP, 'Does not map to Institution in Portico' " & _
            "from tbl_input TI " & _
            "Left Outer Join PORTOWN_PC_TRAINING PCT " & _
            "ON STRCOMP(TI.INTERNSHIP, PCT.NAME,0)=0 " & _
            "where PCT.NAME is NULL " & _
            "and INTERNSHIP <> '' and INTERNSHIP is not null " & _
            "order by TI.ID"
    DoCmd.RunSQL (SQL)
    
'Fellowship
Debug.Print Now() & " " & "Fellowship"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select TI.ID, TI.NPI, 'Fellowship: ' + TI.FELLOWSHIPPROGRAM, 'Does not map to Institution in Portico' " & _
            "from tbl_input TI " & _
            "Left Outer Join PORTOWN_PC_TRAINING PCT " & _
            "ON STRCOMP(TI.FELLOWSHIPPROGRAM, PCT.NAME,0)=0 " & _
            "where PCT.NAME is NULL " & _
            "and FELLOWSHIPPROGRAM <> '' and FELLOWSHIPPROGRAM is not null " & _
            "order by TI.ID"
    DoCmd.RunSQL (SQL)
    
    
'Specialty
Debug.Print Now() & " " & "Specialty"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Specialty: ' + SPECIALTY, 'Does not map to Specialty in Portico' " & _
            "from tbl_input " & _
            "where SPECIALTY <> '' and SPECIALTY is not null " & _
            "and SPECIALTY NOT IN (Select DS from PORTOWN_PP_SPEC) " & _
            "order by ID"
    DoCmd.RunSQL (SQL)

'PLAN
Debug.Print Now() & " " & "Plan"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Plan: ' + PLAN, 'Plan does not exist in Portico' " & _
            "from tbl_input " & _
            "where PLAN not in (select DS from PORTOWN_PP_NET where NET_LEVEL_ID = '4') " & _
            "order by ID"
    DoCmd.RunSQL (SQL)

'NETWORK
Debug.Print Now() & " " & "Network"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Network: ' + NETWORK, 'Network does not exist in Portico' " & _
            "from tbl_input " & _
            "where NETWORK not in (select Cstr(DSL) from PORTOWN_PP_NET where NET_LEVEL_ID = '6') " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
'CITY
Debug.Print Now() & " " & "City"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select TI.ID, TI.NPI, 'City: ' + TI.CITY, 'City does not map to city in Portico' " & _
            "from tbl_input TI " & _
            "Left Join PORTOWN_FMG_CITIES FC " & _
            "ON STRCOMP(TI.CITY, FC.DS,0) = 0 " & _
            "where FC.DS is null"
    DoCmd.RunSQL (SQL)

'Billing CITY
Debug.Print Now() & " " & "Billing City"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select TI.ID, TI.NPI, 'City: ' + TI.BILLINGCITY, 'Billing City does not map to city in Portico' " & _
            "from tbl_input TI " & _
            "Left Join PORTOWN_FMG_CITIES FC " & _
            "ON STRCOMP(TI.BILLINGCITY, FC.DS, 0) = 0 " & _
            "where FC.DS is null"
    DoCmd.RunSQL (SQL)

End Sub

'Check fields for values that are too long.

Sub checkLengths()
Debug.Print Now() & " " & "Check Lengths"
Dim SQL As String
'Zip Code
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Zip Code: ' + ZIPCODE, 'Invalid Zip Code Length (5 or 9).' " & _
            "from tbl_input " & _
            "where Len(ZIPCODE) NOT IN (5,9) " & _
            "order by ID"
    DoCmd.RunSQL (SQL)

'Billing Zip Code
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Billing Zip Code: ' + BILLINGZIPCODE, 'Invalid Zip Code Length (5 or 9).' " & _
            "from tbl_input " & _
            "where Len(BILLINGZIPCODE) NOT IN (5,9) " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
'Insurance Carrier
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Insurance Carrier: ' + INSURANCECARRIER, 'Exceeds maximum characters. (25)' " & _
            "from tbl_input " & _
            "where Len(INSURANCECARRIER) > 25 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
'Delegate
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'Delegate: ' + DELEGATE, 'Exceeds maximum characters. (25)'" & _
            "from tbl_input " & _
            "where Len(DELEGATE) > 25 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
    
'Date Fields
'DOB
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'DATEOFBIRTH: ' + DATEOFBIRTH, 'Date length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(DATEOFBIRTH) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'LICENSEEXPDATE: ' + LICENSEEXPDATE, 'Date length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(LICENSEEXPDATE) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'START_DATE: ' + START_DATE, 'Date length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(START_DATE) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'END_DATE: ' + END_DATE, 'Date length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(END_DATE) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'CREDSTARTDATE: ' + CREDSTARTDATE, 'Date length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(CREDSTARTDATE) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'INSURANCEEXPDATE: ' + INSURANCEEXPDATE, 'Date length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(INSURANCEEXPDATE) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'COMMITTEEAPPROVALDATE: ' + COMMITTEEAPPROVALDATE, 'Date length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(COMMITTEEAPPROVALDATE) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
'Tin
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'TIN: ' + TIN, 'TIN length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(TIN) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
'NPI
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'NPI: ' + NPI, 'NPI length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(NPI) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
'GROUPNPI
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'GROUPNPI: ' + GROUPNPI, 'GROUPNPI length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(GROUPNPI) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)

SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'DATEATTENDEDMEDICALSCHOOL: ' + DATEATTENDEDMEDICALSCHOOL, 'Date length not equal to 10 Characters. '" & _
            "from tbl_input " & _
            "where Len(DATEATTENDEDMEDICALSCHOOL) > 0 AND Len(DATEATTENDEDMEDICALSCHOOL) <> 10 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
   
'Office Hours
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'OFFICE HOURS', 'Office hours must be the format hh:mmAM-hh:mmPM or blank.'" & _
            "from tbl_input " & _
            "where Len(SUNDAYOFFICEHOURS) not in (0,15) " & _
            "or Len(MONDAYOFFICEHOURS) not in (0,15) " & _
            "or Len(TUESDAYOFFICEHOURS) not in (0,15) " & _
            "or Len(WEDNESDAYOFFICEHOURS) not in (0,15) " & _
            "or Len(THURSDAYOFFICEHOURS) not in (0,15) " & _
            "or Len(FRIDAYOFFICEHOURS) not in (0,15) " & _
            "or Len(SATURDAYOFFICEHOURS) not in (0,15) " & _
            "order by ID"
    DoCmd.RunSQL (SQL)

End Sub

'Check Business Rules
Sub checkBusRules()
DoCmd.SetWarnings False
Debug.Print Now() & " " & "Check Business Rules"
Dim SQL As String
Dim i As Integer
Dim strReqFields As Variant
strReqFields = Array("SSN", "LASTNAME", "FIRSTNAME", "DEGREE", "DATEOFBIRTH", "GENDER", "LANGUAGE1", "PLAN", "DELEGATESTATUS", _
"DELEGATE", "NETWORK", "START_DATE", "END_DATE", "SPECIALTY", "PCP", "BOARDCERTIFIED", _
"CREDSTARTDATE", "PROVIDER_TYPE", "INSURANCECARRIER", "INSURANCEEXPDATE", "INSURANCEAMOUNT", _
"COMMITTEEAPPROVALDATE")

'Find Group Practice records without Group NPI
'SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select ID, NPI, 'GROUP: ' + BILLINGNAME, 'Group Provider with no Group NPI.' " & _
            "from tbl_input " & _
            "where PROVIDER_TYPE = 'GROUP PRACTICE' and Len(NZ(GROUPNPI)) = 0 " & _
            "order by ID"
    'DoCmd.RunSQL (SQL)
    
'Find matching TIN and GROUPNPI with different BILLINGNAME
    SQL = "Insert into tbl_errors (ID, NPI, Field, MSG) " & _
            "Select ID, NPI, 'TIN + Group NPI + Name: ' + TIN + '-' +GROUPNPI + ' ' + BILLINGNAME, 'Matching Group NPI and TIN with different Billing Name' " & _
            "FROM tbl_input AS a " & _
            "WHERE 0 < (SELECT Count(1) " & _
            "FROM tbl_input AS b " & _
            "WHERE b.TIN = a.TIN " & _
            "AND b.GROUPNPI = a.GROUPNPI " & _
            "AND b.BILLINGNAME <> a.BILLINGNAME) "

    DoCmd.RunSQL (SQL)

'Find Physicians with age > 70

SQL = "Insert into tbl_errors (ID, NPI, Field, MSG) " & _
            "Select ID, NPI, 'DATEOFBIRTH: ' + DATEOFBIRTH, 'Physician Age >= 70' " & _
            "from tbl_input " & _
            "where DateDiff('yyyy', CDate(Nz(DATEOFBIRTH,0)), now()) + (now() < DateSerial(Year(NOW()), Month(CDate(Nz(DATEOFBIRTH,0))), Day(CDate(Nz(DATEOFBIRTH,0))) )) >= 70 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)
    
   
'Find Physicians with expired license
' "where DateDiff('yyyy', CDate(Nz(DATEOFBIRTH,0)), now()) >= 70 " & _

SQL = "Insert into tbl_errors (ID, NPI, Field, MSG) " & _
            "Select ID, NPI, 'LICENSEEXPDATE: ' + LICENSEEXPDATE, 'License Expired' " & _
            "from tbl_input " & _
            "where DateDiff('d', CDate(Nz(LICENSEEXPDATE,0)), now()) > 0 " & _
            "order by ID"
    DoCmd.RunSQL (SQL)

'Find Practitioners with same NPI and different name or SSN
    SQL = "Insert into tbl_errors (ID, NPI, Field, MSG) " & _
            "Select ID, NPI, ('NPI: ' + LastName + ', ' + FirstName + ' ' + SSN), 'Same NPI with different Name or SSN' " & _
            "FROM tbl_input AS a " & _
            "WHERE 0 < (SELECT Count(1) " & _
            "FROM tbl_input AS b " & _
            "WHERE b.NPI = a.NPI " & _
            "AND (b.LASTNAME <> a.LASTNAME " & _
            " or b.FIRSTNAME <> a.FIRSTNAME " & _
            " or b.SSN <> a.SSN)) "
    DoCmd.RunSQL (SQL)
'DoCmd.SetWarnings True

'Find Difference in Required Field with same NPI NOTE:  Access SQL doesn't support COUNT DISTINCT
For i = 0 To UBound(strReqFields, 1)
    'Debug.Print Now() & " " & strReqFields(i)
    SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "SELECT ID, TI.NPI, '" & strReqFields(i) & "', 'Required Field " & strReqFields(i) & " Differs on Same Practitioner' " & _
            "FROM tbl_input TI " & _
            "INNER JOIN " & _
            "(SELECT NPI, COUNT(" & strReqFields(i) & ") FROM " & _
            "(SELECT DISTINCT NPI, " & strReqFields(i) & " FROM TBL_INPUT ) GROUP BY NPI HAVING COUNT(1) > 1) REQ " & _
            "ON TI.NPI = REQ.NPI " & _
            "ORDER BY ID"
    'Debug.Print Now() & " " & SQL
    DoCmd.RunSQL (SQL)
    Next i
    
'Check Practitioner for Primary Location.  Must have primary LOC to go over to AMISYS
    SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "SELECT ID, TI.NPI, 'PRACLOCISPRIMARY', 'No Primary Location for Practitioner' " & _
            "FROM tbl_input TI " & _
            "WHERE NPI NOT IN " & _
            "(SELECT NPI FROM tbl_input WHERE PRACLOCISPRIMARY = 'Y')"
    DoCmd.RunSQL (SQL)
    
'Check Group Prov for Primary Location.  Must have primary LOC to go over to AMISYS
    SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "SELECT ID, TI.BILLINGNAME, 'PROVLOCISPRIMARY', 'No Primary Location for Provider' " & _
            "FROM tbl_input TI " & _
            "WHERE BILLINGNAME NOT IN " & _
            "(SELECT BILLINGNAME FROM tbl_input WHERE PROVLOCISPRIMARY = 'Y')"
    DoCmd.RunSQL (SQL)
End Sub




'Check to see that all required fields are populated.  Loop through list of required fields.
Sub checkReqFields()
Debug.Print Now() & " " & "Check Required Fields"
    Dim SQL As String
    Dim i As Integer
    Dim strReqFields As Variant
    strReqFields = Array("SSN", "LASTNAME", "FIRSTNAME", "DEGREE", "DATEOFBIRTH", "GENDER", "LANGUAGE1", "PLAN", "DELEGATESTATUS", _
    "DELEGATE", "NETWORK", "START_DATE", "END_DATE", "SPECIALTY", "PCP", "BOARDCERTIFIED", "TAXONOMY", "LICENSENUM", "LICENSEEXPDATE", _
    "LICENSESTATE", "CREDSTARTDATE", "TIN", "NPI", "PROVIDER_TYPE", "ADDRLINE1", "CITY", "STATE", "ZIPCODE", "PHONE", "BILLINGADDRLINE1", _
    "BILLINGCITY", "BILLINGSTATE", "BILLINGZIPCODE", "BILLINGPHONE", "INSURANCECARRIER", "INSURANCEEXPDATE", "INSURANCEAMOUNT", _
    "COMMITTEEAPPROVALDATE")
    For i = 0 To UBound(strReqFields, 1)
    'Debug.Print Now() & " " &  strReqFields(i)
    SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "SELECT ID, NPI,'" & strReqFields(i) & "', 'Null Value in Required Field " & strReqFields(i) & "' " & _
            "FROM tbl_input " & _
            "where " & strReqFields(i) & " = '' or " & strReqFields(i) & " is NULL " & _
            "order by ID"
    'Debug.Print Now() & " " &  SQL
    DoCmd.RunSQL (SQL)
    Next i
End Sub

'Main sub executed for FULL SCAN.

Sub main()
Dim Response As Integer
DoCmd.SetWarnings False
Run "importSheet"
Run "checkNullID"
Run "checkDupRec"
Run "checkReqFields"
Run "checkLengths"
Run "checkBusRules"
Run "checkMappedValues"
Debug.Print Now() & " " & "Analysis Complete"
Response = MsgBox("Analysis Complete", vbOKOnly, "")
End Sub

Sub rulesOnly()
DoCmd.SetWarnings False
Run "checkNullID"
Run "checkDupRec"
Run "checkReqFields"
Run "checkLengths"
Run "checkBusRules"
DoCmd.SetWarnings True
Debug.Print Now() & " " & "Analysis Complete"
End Sub


Sub Dev_sub() 'Development
'Check City Zip combos

Debug.Print Now() & " " & "City ZIP"
SQL = "Insert into tbl_errors (ID, NPI, FIELD, MSG) " & _
            "Select TI.ID, TI.NPI, 'City Zip: ' + TI.CITY + ' ' + TI.ZIP, 'City Zip combo not in Portico' " & _
            "from tbl_input TI " & _
            "Left Join PORTOWN_FMG_CITIES FC " & _
            "ON STRCOMP(TI.CITY, FC.DS,0) = 0 " & _
            "where FC.DS is null"
    DoCmd.RunSQL (SQL)

End Sub
Open in new window
Martin Liss
Record a macro while you Find one of the headings that adapt and add that code,

If would start with something like

Dim hdr as range

set hdr = Find……

msgbox hdr.column
njohnson6378
ASKER
ive done thta. It doesnt work. I believe it has to do with the array, but im not sure how to proceed without it
jerryb30
If the headers will match in name, if not in order, import the excel data into a temp table.
Then append to the final table with
INSERT INTO table2
SELECT Table1.*
FROM Table1;

Access will figure it out.
ASKER CERTIFIED SOLUTION
Martin Liss
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
See answer
njohnson6378
ASKER
OK I see where you are going now. Thank you for the assistance
Martin Liss
You're welcome and I'm glad I was able to help.

Marty - MVP 2009 to 2012
njohnson6378
ASKER
Any Idea why I would get a 'cells' of object'_global' failed?
Martin Liss
Which line?

It's most likely looking for a value in "What" that doesn't exist.
njohnson6378
ASKER
Set rSSN = Cells.Find(What:=strReqFields(0), After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
, SearchFormat:=False)

when i hover over the what it shows SSN
Martin Liss
Do you have exactly that in a header?
njohnson6378
ASKER
thanks for the help again Martin, VBA is not my specialty by far
njohnson6378
ASKER
yes I do
Martin Liss
Well I know that my little sample code worked, so what are you doing differently? Maybe you should post the code or workbook.
njohnson6378
ASKER
Yeah Ill do a new questions. Thanks MArtin.