Over Flow Error and Run-time Error '3075':

[W4FF]

I'm having issues with Access 2010, the interface includes the following input options:Last Name, First Name, SSN, and Birth date.

Access was working great since 2012 and all of a sudden we are getting issues since the 21 of January 2015, here are the following errors:

1. Overflow
2. Run-time Error'3075':
Syntax error in query expression 'LastNameLike'*Akers*' AND FirstName Like'*Mike*'AND SSN Like'*100101001*'; DOB Like#4/24/1982#'.

I used the debug tool and it takes me to Me.Referral.Form.Filter = filterstr

Here is the section of the Code that the debugger highlighted:

Private Sub filters()
Dim filterstr As String
Dim filterlast As String
Dim filterfirst As String
Dim filterssn As String
Dim filterdob As String
 
filterlast = IIf(IsNull(LastName) = False, "LastName Like '*" & Me.LastName & "*'", " ")
filterfirst = IIf(IsNull(FirstName) = False, "FirstName Like '*" & Me.FirstName & "*'", " ")
filterssn = IIf(IsNull(SSN) = False, "SSN Like '*" & Me.SSN & "*'", " ")
filterdob = IIf(IsNull(BirthDate) = False, "DOB Like #" & Me.BirthDate & "#", " ")
 
'MsgBox Len(filterdob)
 
If Len(filterlast) > 2 And Len(filterfirst) < 2 And Len(filterssn) < 2 And Len(filterdob) < 2 Then
    filterstr = filterlast
 
ElseIf Len(filterlast) > 2 And Len(filterfirst) > 2 And Len(filterssn) < 2 And Len(filterdob) < 2 Then
    filterstr = filterlast & " AND " & filterfirst
 
ElseIf Len(filterlast) > 2 And Len(filterfirst) > 2 And Len(filterssn) > 2 And Len(filterdob) < 2 Then
    filterstr = filterlast & " AND " & filterfirst & " AND " & filterssn
 
ElseIf Len(filterlast) > 2 And Len(filterfirst) > 2 And Len(filterssn) > 2 And Len(filterdob) > 2 Then
    filterstr = filterlast & " AND " & filterfirst & " AND " & filterssn & ";" & filterdob
 
 
ElseIf Len(filterlast) > 2 And Len(filterfirst) < 2 And Len(filterssn) > 2 And Len(filterdob) < 2 Then
    filterstr = filterlast & " AND " & filterssn
 
ElseIf Len(filterlast) < 2 And Len(filterfirst) > 2 And Len(filterssn) > 2 And Len(filterdob) > 2 Then
    filterstr = filterfirst & " AND " & filterssn & " AND " & filterdob
 
ElseIf Len(filterlast) < 2 And Len(filterfirst) < 2 And Len(filterssn) > 2 And Len(filterdob) > 2 Then
    filterstr = filterssn & " AND " & filterdob
 
ElseIf Len(filterlast) < 2 And Len(filterfirst) < 2 And Len(filterssn) < 2 And Len(filterdob) > 2 Then
    filterstr = filterdob
 
End If
Me.Referral.Form.Filter = filterstr
Me.Referral.Form.FilterOn = True
End Sub

[W4FF]

Debugger is highlighting the following in bold:

End If
 Me.Referral.Form.Filter = filterstr
Me.Referral.Form.FilterOn = True
End Sub

[Stewart Ross]

Your problem is at line 25 in the segment above, where a semicolon has been put in place of an AND:

filterstr = filterlast & " AND " & filterfirst & " AND " & filterssn & ";" & filterdob

Replace with

filterstr = filterlast & " AND " & filterfirst & " AND " & filterssn & " AND " & filterdob

The syntax error message is absolutely accurate - you will see the semicolon just before the DOB in your original post. As the filter string is in error all the other errors you are getting should disappear when you fix the cause listed.

-Stewart

[W4FF]

I did what you ask and now I get Run-time error Syntax error (missing operator)

[W4FF]

Here is the entire code just in case I'm missing something:

Option Compare Database
Private Sub BirthDate_AfterUpdate()
filters
End Sub
 
Private Sub Closeform_Click()
MsgBox ("Exiting Intake Portal. Click on OK")
DoCmd.Quit
End Sub
 
Private Sub Command47_Click()
Me.Referral.Form.FilterOn = False
LastName = Null
FirstName = Null
SSN = Null
DOB = Null
End Sub
 
Private Sub createref_Click()
On Error GoTo Err_createref_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
    Dim args As String
    Dim sqlstring As String
    Dim sqlstring2 As Variant
    Dim temprecord As Recordset
    Dim intRow As Integer
 
 
    notfound = 0
    intRow = 0
    sqlstring = "SELECT LASTNAME & '|' & FIRSTNAME & '|' , referralid FROM REFERRAL order by referralid"
    Set temprecord = CurrentDb.OpenRecordset(sqlstring, dbOpenDynaset, dbSeeChanges)
    args = IIf(IsNull(LastName), "", LastName) & "|"
    args = args & IIf(IsNull(FirstName), "", FirstName) & "|"
 
 
    If temprecord.EOF = True Then
        stDocName = "F_ADD"
        args = args & IIf(IsNull(SSN), "", SSN) & "|"
        args = args & IIf(IsNull(BirthDate), "", BirthDate) & "|"
 
        DoCmd.OpenForm stDocName, , , , acFormAdd, , args
    Else
 
         temprecord.MoveLast
         getrecord = temprecord.RecordCount
         sqlstring2 = temprecord.GetRows(getrecord)
         While notfound = 0
 
             If (intRow - getrecord) = 0 Then
                notfound = -1
                stDocName = "F_ADD"
                args = args & IIf(IsNull(SSN), "", SSN) & "|"
                args = args & IIf(IsNull(BirthDate), "", BirthDate) & "|"
                DoCmd.OpenForm stDocName, , , , acFormAdd, , args
 
    '        ElseIf args = sqlstring2(0, intRow) Then
    '            notfound = -1
    '            stDocName = "F_EDIT"
    '            DoCmd.OpenForm stDocName, , "ReferralID = " & sqlstring2(1, intRow), "ReferralID = " & sqlstring2(1, intRow)
             End If
             intRow = intRow + 1
        Wend
    End If
 
 
 
 
Exit_createref_Click:
    Exit Sub
 
Err_createref_Click:
    MsgBox Err.Description
    Resume Exit_createref_Click
 
 
End Sub
 
Private Sub FirstName_AfterUpdate()
filters
End Sub
 
 
 
Private Sub Form_DblClick(Cancel As Integer)
MsgBox "Please single click. Do not double click"
DoCmd.CancelEvent
End Sub
 
Private Sub Form_Load()
    Dim stDocName As String
    Dim stLinkCriteria As String
    Dim args As String
    Dim sqlstring As String
    Dim sqlstring2 As Variant
    Dim temprecord As Recordset
    Dim intRow As Integer
 
'    DoCmd.SetWarnings False
 '   notfound = 0
  '  intRow = 0
   ' lookup = "SELECT * FROM UPDATETHERAPISTNEED"
   ' Set temprecord = CurrentDb.OpenRecordset(lookup)
 
 
    'If temprecord.BOF <> temprecord.EOF Then
    '    sqlstring2 = temprecord.GetRows(1)
    '    sqlstring = "UPDATE dbo_EMPLOYEENEED SET dbo_EMPLOYEENEED.NEEDPERDAY = " & sqlstring2(1, 0)
    '    sqlstring = sqlstring & " WHERE dbo_EMPLOYEENEED.THERAPISTEMPLOYEEID like '" & Trim(sqlstring2(0, 0)) & "'"
 
        'DoCmd.RunSQL sqlstring
 
 
    'End If
 
'DoCmd.OpenQuery "LOAD DIRECTOR"
 
  '  notfound = 0
 '   intRow = 0
   ' lookup = "SELECT * FROM UPDATEASSESSORNEED"
    'Set temprecord = CurrentDb.OpenRecordset(lookup)
 
 
    'If temprecord.BOF <> temprecord.EOF Then
     '   sqlstring2 = temprecord.GetRows(1)
      '  sqlstring = "UPDATE dbo_EMPLOYEENEED SET dbo_EMPLOYEENEED.NEEDPERDAY = " & sqlstring2(1, 0)
      '  sqlstring = sqlstring & " WHERE dbo_EMPLOYEENEED.ASSESSOREMPLOYEEID like '" & Trim(sqlstring2(0, 0)) & "'"
 
        'DoCmd.RunSQL sqlstring
 
 
    'End If
 
'DoCmd.OpenQuery "LOAD ASSESSOR"
 
End Sub
 
Private Sub LastName_AfterUpdate()
filters
End Sub
Private Sub filters()
Dim filterstr As String
Dim filterlast As String
Dim filterfirst As String
Dim filterssn As String
Dim filterdob As String
 
filterlast = IIf(IsNull(LastName) = False, "LastName Like '*" & Me.LastName & "*'", " ")
filterfirst = IIf(IsNull(FirstName) = False, "FirstName Like '*" & Me.FirstName & "*'", " ")
filterssn = IIf(IsNull(SSN) = False, "SSN Like '*" & Me.SSN & "*'", " ")
filterdob = IIf(IsNull(BirthDate) = False, "DOB Like #" & Me.BirthDate & "#", " ")
 
'MsgBox Len(filterdob)
 
If Len(filterlast) > 2 And Len(filterfirst) < 2 And Len(filterssn) < 2 And Len(filterdob) < 2 Then
    filterstr = filterlast
 
ElseIf Len(filterlast) > 2 And Len(filterfirst) > 2 And Len(filterssn) < 2 And Len(filterdob) < 2 Then
    filterstr = filterlast & " AND " & filterfirst
 
ElseIf Len(filterlast) > 2 And Len(filterfirst) > 2 And Len(filterssn) > 2 And Len(filterdob) < 2 Then
    filterstr = filterlast & " AND " & filterfirst & " AND " & filterssn
 
' Changed on line 25 below from & ";" & filterdob to "AND"
 
ElseIf Len(filterlast) > 2 And Len(filterfirst) > 2 And Len(filterssn) > 2 And Len(filterdob) > 2 Then
    filterstr = filterlast & " AND " & filterfirst & " AND " & filterssn & "AND" & filterdob
 
 
ElseIf Len(filterlast) > 2 And Len(filterfirst) < 2 And Len(filterssn) > 2 And Len(filterdob) < 2 Then
    filterstr = filterlast & " AND " & filterssn
 
ElseIf Len(filterlast) < 2 And Len(filterfirst) > 2 And Len(filterssn) > 2 And Len(filterdob) > 2 Then
    filterstr = filterfirst & " AND " & filterssn & " AND " & filterdob
 
ElseIf Len(filterlast) < 2 And Len(filterfirst) < 2 And Len(filterssn) > 2 And Len(filterdob) > 2 Then
    filterstr = filterssn & " AND " & filterdob
 
ElseIf Len(filterlast) < 2 And Len(filterfirst) < 2 And Len(filterssn) < 2 And Len(filterdob) > 2 Then
    filterstr = filterdob
 
End If
Me.Referral.Form.Filter = filterstr
Me.Referral.Form.FilterOn = True
End Sub
 
Private Sub SSN_AfterUpdate()
filters
End Sub
 

[Rabbit]

It would help to see the filter string that it is attempting to use.

Also, it would be simpler in your code to build the string like this:

Dim strFilter As String
 
If Not IsNull(field1) Then
   strFilter = strFilter & " AND field1 LIKE '*" & Me.formfield1 & "*'"
End If
 
... and so on for the other fields ...
 
strFilter = Mid(strFilter, 6)

[W4FF]

The Run-time Error'3075': error is gone but I still have the over flow error. Please help.

[Rabbit]

It would help to see the filter string that it is attempting to use.

[W4FF]

I think this is it, the last guy in my department left me with this mess to fix, and i'm new to ACCESS

Private Sub ClearFilter_Click()
clearfilters
End Sub
Private Sub AssessorId_AfterUpdate()
Dim lookup As String
Dim temprecord As Recordset
Dim emailfind As String
Dim var As Variant
 
DoCmd.SetWarnings (False)
If IsNull(Me.AssessorId) = False Then
    lookup = "SELECT Name, Email FROM VIEW_ASSESSOR_EMAIL WHERE ASSESSOREMPLOYEEID = '"
    lookup = lookup & Me.AssessorId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
 
    var = temprecord.GetRows(1)
 
    AssessorName.Caption = IIf(temprecord.RecordCount <> 0, "Name:" & var(0, 0), " ")
    AssessorEmailName.Caption = IIf(temprecord.RecordCount <> 0, "Email:" & var(1, 0), " ")
End If
End Sub
 
Private Sub Command53_Click()
clearfilters
End Sub
Private Sub clearfilters()
    lookup = "SELECT ASSESSOREMPLOYEEID, NAME, ZONE, ORIGINALNEED, REFERRALCOUNT, AVAILABILITY  FROM VIEW_ASSESSOR_AVAILABLE "
    lookup = lookup & " GROUP BY ASSESSOREMPLOYEEID, NAME, GENDER, ZONE, ORIGINALNEED, REFERRALCOUNT, AVAILABILITY "
'    lookup = IIf(IsNull(Me.AssessmentZoneID), lookup, lookup & " HAVING Zone = '" & ZONES & "'")
lookup = lookup & " ORDER BY ZONE ASC"
    AssessorId.RowSource = lookup
 
 
    lookup = "SELECT THERAPISTEMPLOYEEID, NAME, ZONE, NEED FROM VIEW_THERAPIST_AVAILABLE "
    lookup = lookup & " GROUP BY THERAPISTEMPLOYEEID, NAME, GENDER, ZONE, NEED"
'    lookup = IIf(IsNull(Me.ServiceZoneID), lookup, lookup & " HAVING Zone like '" & ZONES & "'")
lookup = lookup & " ORDER BY ZONE ASC"
 
    TherapistId.RowSource = lookup
 
    Me.SCREENFILTER.Caption = "A"
End Sub
 
Private Sub Command55_Click()
Dim stDocName As String
Dim stLinkCriteria As String
Dim args As String
Dim sqlstring As String
Dim sqlstring2 As Variant
Dim temprecord As Recordset
Dim intRow As Integer
Dim findid As Long
Dim findString As String
 
Me.ModifiedByID = VBA.Environ("USERNAME")
Me.CreateByID = VBA.Environ("USERNAME")
Me.CreateDT = Now()
Me.ModifiedDT = Now()
 
    sqlstring = "INSERT INTO [NOTE] (REFERRALID, [NOTE], INTAKEDT, CREATEDBY) VALUES("
    sqlstring = sqlstring & Me.ReferralId & ", 'EPISODE OF CARE CREATED', #" & Now() & "#, '" & VBA.Environ("USERNAME") & "')"
    DoCmd.RunSQL (sqlstring)
 
DoCmd.RunCommand acCmdSaveRecord
    notfound = 0
    intRow = 0
 
 
   findid = ReferralId
   stDocName = "F_EDIT"
   findString = "ReferralID = " & findid
   DoCmd.Close acForm, "REFERRALSERVICES_Add"
'   DoCmd.OpenForm stDocName, findString, findString
 
End Sub
 
Private Sub EmailTherapist_Click()
Dim lookup As String
Dim temprecord As Recordset
Dim emailfind As String
Dim var As Variant
 
DoCmd.SetWarnings (False)
'Did you add ALS
 
    lookup = "SELECT Name, Email FROM VIEW_THERAPIST_EMAIL WHERE THERAPISTEMPLOYEEIDs = '"
    lookup = lookup & Me.TherapistId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
    var = temprecord.GetRows(1)
 
    If temprecord.RecordCount <> 0 Then
        DoCmd.RunCommand acCmdSaveRecord
        DoCmd.OpenForm "F_PDF", acPreview, "ReferralID = Forms!F_Edit!ReferralID", "ReferralID =" & Forms!F_Edit!ReferralId
        DoCmd.SendObject acSendForm, "F_PDF", acFormatPDF, var(1, 0), "[e-mail]"
        DoCmd.Close acForm, "F_PDF"
    End If
 
End Sub
 
 
Private Sub EmailAssessor_Click()
Dim lookup As String
Dim temprecord As Recordset
Dim emailfind As String
Dim var As Variant
 
DoCmd.SetWarnings (False)
'Did you add ALS
lookup = "SELECT name, Email FROM VIEW_ASSESSOR_EMAIL WHERE ASSESSOREMPLOYEEID = '"
lookup = lookup & Me.AssessorId
lookup = lookup & "'"
Set temprecord = CurrentDb.OpenRecordset(lookup)
 
If temprecord.RecordCount <> 0 Then
    var = temprecord.GetRows(1)
    DoCmd.RunCommand acCmdSaveRecord
        DoCmd.OpenForm "F_PDF", acPreview, "ReferralID = ReferralID", "ReferralID =" & ReferralId
    DoCmd.SendObject acSendForm, "F_PDF", acFormatPDF, var(1, 0), , "[e-mail]"
    DoCmd.Close acForm, "F_PDF"
End If
 
 
End Sub
 
 
 
Private Sub Form_Current()
Dim lookup As String
Dim temprecord As Recordset
Dim emailfind As String
Dim var As Variant
Dim strValue As String
Dim counter As Integer
Dim sqlstring As String
Dim sqlstring2 As Variant
Dim temprecords As Recordset
Dim referralidnew As Long
  Form.FilterOn = False
Form.FilterOn = True
  Me.ReferralId = Me.OpenArgs
 
    lookup = "SELECT LASTNAME & ', ' & FIRSTNAME, servicezoneid, assessmentzoneid, school, PreferredLanguageforAssessment, PreferredLanguageforService, servicelocation, assessmentlocation from Referral WHERE ReferralID = "
    lookup = lookup & Me.ReferralId
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
 
    var = temprecord.GetRows(1)
 
If var(6, 0) = "School" Or var(7, 0) = "School" Then
Me.School = var(3, 0)
End If
Me.ReferralName.Caption = var(0, 0)
Me.ServiceZoneID = var(1, 0)
Me.AssessmentZoneID = var(2, 0)
Me.LanguageAssessment = var(4, 0)
Me.LanguageServices = var(5, 0)
 
Me.SCREENFILTER.Caption = "A"
DoCmd.SetWarnings (False)
If IsNull(Me.AssessorId) = False Then
    lookup = "SELECT Name, Email FROM VIEW_ASSESSOR_EMAIL WHERE ASSESSOREMPLOYEEID like '"
    lookup = lookup & Me.AssessorId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
 
    var = temprecord.GetRows(1)
 
    AssessorName.Caption = IIf(temprecord.RecordCount <> 0, var(0, 0), " ")
    AssessorEmailName.Caption = IIf(temprecord.RecordCount <> 0, var(1, 0), " ")
    Me.SCREENFILTER.Caption = "C"
Else
    AssessorName.Caption = ""
    AssessorEmailName.Caption = ""
    ENABLEFILTER
End If
 
If IsNull(Me.TherapistId) = False Then
    lookup = "SELECT Name, Email FROM VIEW_THERAPIST_EMAIL WHERE THERAPISTEMPLOYEEIDs like '"
    lookup = lookup & Me.TherapistId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
    var = temprecord.GetRows(1)
 
    TherapistName.Caption = IIf(temprecord.RecordCount <> 0, var(0, 0), " ")
    TherapistEmailName.Caption = IIf(temprecord.RecordCount <> 0, var(1, 0), " ")
    Me.SCREENFILTER.Caption = "C"
Else
    TherapistName.Caption = ""
    TherapistEmailName.Caption = ""
    ENABLEFILTER
End If
 
 
End Sub
 
Private Sub Form_Load()
Dim lookup As String
Dim temprecord As Recordset
Dim emailfind As String
Dim var As Variant
Dim strValue As String
Dim counter As Integer
Dim sqlstring As String
Dim sqlstring2 As Variant
Dim temprecords As Recordset
Dim referralidnew As Long
 
If Len(Me.oldtherapist) = 0 Then
    Me.oldtherapist = "NO VALUE"
Else
    Me.oldtherapist = Me.TherapistId
End If
 
  Form.FilterOn = False
Form.FilterOn = True
  Me.ReferralId = Me.OpenArgs
    lookup = "SELECT LASTNAME & ', ' & FIRSTNAME, servicezoneid, assessmentzoneid, school, PreferredLanguageforAssessment, PreferredLanguageforService, servicelocation, assessmentlocation from Referral WHERE ReferralID = "
    lookup = lookup & Me.ReferralId
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
 
    var = temprecord.GetRows(1)
 
If var(6, 0) = "School" Or var(7, 0) = "School" Then
Me.School = var(3, 0)
End If
Me.ReferralName.Caption = var(0, 0)
Me.ServiceZoneID = var(1, 0)
Me.AssessmentZoneID = var(2, 0)
Me.LanguageAssessment = var(4, 0)
Me.LanguageServices = var(5, 0)
Me.SCREENFILTER.Caption = "A"
DoCmd.SetWarnings (False)
If IsNull(Me.AssessorId) = False Then
    lookup = "SELECT Name, Email FROM VIEW_ASSESSOR_EMAIL WHERE ASSESSOREMPLOYEEID like '"
    lookup = lookup & Me.AssessorId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
 
    var = temprecord.GetRows(1)
 
    AssessorName.Caption = IIf(temprecord.RecordCount <> 0, var(0, 0), " ")
    AssessorEmailName.Caption = IIf(temprecord.RecordCount <> 0, var(1, 0), " ")
    Me.SCREENFILTER.Caption = "C"
Else
    AssessorName.Caption = ""
    AssessorEmailName.Caption = ""
    ENABLEFILTER
End If
 
If IsNull(Me.TherapistId) = False Then
    lookup = "SELECT Name, Email FROM VIEW_THERAPIST_EMAIL WHERE THERAPISTEMPLOYEEIDs like '"
    lookup = lookup & Me.TherapistId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
    var = temprecord.GetRows(1)
 
    TherapistName.Caption = IIf(temprecord.RecordCount <> 0, var(0, 0), " ")
    TherapistEmailName.Caption = IIf(temprecord.RecordCount <> 0, var(1, 0), " ")
    Me.SCREENFILTER.Caption = "C"
Else
    TherapistName.Caption = ""
    TherapistEmailName.Caption = ""
    ENABLEFILTER
End If
 
 
End Sub
Private Sub ENABLEFILTER()
Me.SCREENFILTER.Caption = "B"
 
End Sub
 
Private Sub Form_Open(Cancel As Integer)
Dim lookup As String
Dim temprecord As Recordset
Dim emailfind As String
Dim var As Variant
Dim strValue As String
Dim counter As Integer
Dim sqlstring As String
Dim sqlstring2 As Variant
Dim temprecords As Recordset
Dim referralidnew As Long
 
Me.SCREENFILTER.Caption = "A"
DoCmd.SetWarnings (False)
If IsNull(Me.AssessorId) = False Then
    lookup = "SELECT Name, Email FROM VIEW_ASSESSOR_EMAIL WHERE ASSESSOREMPLOYEEID like '"
    lookup = lookup & Me.AssessorId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
 
    var = temprecord.GetRows(1)
 
    AssessorName.Caption = IIf(temprecord.RecordCount <> 0, var(0, 0), " ")
    AssessorEmailName.Caption = IIf(temprecord.RecordCount <> 0, var(1, 0), " ")
    Me.SCREENFILTER.Caption = "C"
Else
    AssessorName.Caption = ""
    AssessorEmailName.Caption = ""
 
End If
 
If IsNull(Me.TherapistId) = False Then
    lookup = "SELECT Name, Email FROM VIEW_THERAPIST_EMAIL WHERE THERAPISTEMPLOYEEIDs like '"
    lookup = lookup & Me.TherapistId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
    var = temprecord.GetRows(1)
 
    TherapistName.Caption = IIf(temprecord.RecordCount <> 0, var(0, 0), " ")
    TherapistEmailName.Caption = IIf(temprecord.RecordCount <> 0, var(1, 0), " ")
    Me.SCREENFILTER.Caption = "C"
Else
    TherapistName.Caption = ""
    TherapistEmailName.Caption = ""
 
End If
 
End Sub
 
Private Sub GenderRequirements_BeforeUpdate(Cancel As Integer)
ENABLEFILTER
End Sub
 
Private Sub LicensedRequired_AfterUpdate()
ENABLEFILTER
End Sub
 
Private Sub SafetyRequired_AfterUpdate()
ENABLEFILTER
End Sub
 
Private Sub School_AfterUpdate()
ENABLEFILTER
End Sub
 
Private Sub StaartRequired_AfterUpdate()
ENABLEFILTER
End Sub
 
Private Sub StatusId_AfterUpdate()
If Left(Me.StatusId, 8) = "Inactive" Then
    Me.InactiveDT = FormatDateTime(Now, vbShortDate)
    Me.InactiveReason.SetFocus
 
ElseIf Me.StatusId = "Discharged" Then
    Me.InactiveDT = FormatDateTime(Now, vbShortDate)
 
ElseIf Me.StatusId = "Client" Then
    Me.InactiveDT = FormatDateTime(Now + 365, vbShortDate)
End If
End Sub
 
Private Sub AssessorId_Enter()
Dim ZONES As String
Dim LICENSES As String
Dim TRAINS As String
Dim CreoleS  As String
Dim FrenchS As String
Dim ItalianS As String
Dim PortugueseS As String
Dim RussianS As String
Dim SpanishS As String
Dim GENDERS As String
 
DoCmd.SetWarnings (False)
 
ZONES = IIf(IsNull(AssessmentZoneID), "", Me.AssessmentZoneID)
If IsNull(Me.LicensedRequired) Then
    LICENSES = ""
Else
    LICENSES = IIf(Me.LicensedRequired = 0, "", "YES")
End If
If IsNull(Me.SafetyTrainingRequired) And IsNull(Me.StaartTrainingRequired) Then
    TRAINS = ""
Else
    TRAINS = IIf((Me.SafetyTrainingRequired + Me.StaartTrainingRequired) < 1, "", "YES")
End If
If IsNull(Me.GenderRequirements) Then
    GENDERS = ""
Else
    GENDERS = IIf(Me.GenderRequirements = "FEMALE", "FEMALE", "MALE")
End If
CreoleS = IIf(Me.LanguageAssessment = "Creole", "YES", "")
FrenchS = IIf(Me.LanguageAssessment = "French", "YES", "")
ItalianS = IIf(Me.LanguageAssessment = "Italian", "YES", "")
PortugueseS = IIf(Me.LanguageAssessment = "Portuguese", "YES", "")
RussianS = IIf(Me.LanguageAssessment = "Russian", "YES", "")
SpanishS = IIf(Me.LanguageAssessment = "Spanish", "YES", "")
 
 
If Me.SCREENFILTER.Caption = "B" Then
    If IsNull(School) = False Then
        lookup = "SELECT ASSESSOREMPLOYEEID, NAME, ZONE, NEED, REFERRALCOUNT, AVAILABILITY, SCHOOL "
        lookup = lookup & "FROM VIEW_SELECTASSESSORWITHSCHOOL "
        lookup = lookup & "GROUP BY ASSESSOREMPLOYEEID, NAME, NEED, REFERRALCOUNT, AVAILABILITY, SCHOOL,"
        lookup = lookup & "GENDER, ZONE, LICENSE, TRAIN, CREOLE, FRENCH, ITALIAN, PORTUGUESE, RUSSIAN, SPANISH "
        lookup = lookup & "HAVING "
        lookup = lookup & "SCHOOL='" & Me.School & "' "
        lookup = IIf(Len(GENDERS) < 2, lookup, lookup & "AND GENDER = '" & GENDERS & "' ")
        lookup = IIf(Len(ZONESS) < 2, lookup, lookup & "AND ZONE = '" & ZONES & "' ")
        lookup = IIf(Len(LICENSES) < 2, lookup, lookup & "AND LICENSE = '" & LICENSES & "' ")
        lookup = IIf(Len(TRAINS) < 2, lookup, lookup & "AND TRAIN = '" & TRAINS & "' ")
        lookup = IIf(Len(CreoleS) < 2, lookup, lookup & "AND CREOLE = '" & CreoleS & "' ")
        lookup = IIf(Len(FrenchS) < 2, lookup, lookup & "AND French = '" & FrenchS & "' ")
        lookup = IIf(Len(ItalianS) < 2, lookup, lookup & "AND Italian = '" & ItalianS & "' ")
        lookup = IIf(Len(PortugueseS) < 2, lookup, lookup & "AND Portuguese = '" & PortugueseS & "' ")
        lookup = IIf(Len(RussianS) < 2, lookup, lookup & "AND Russian = '" & RussianS & "' ")
        lookup = IIf(Len(SpanishS) < 2, lookup, lookup & "AND Spanish = '" & SpanishS & "' ")
        lookup = lookup & "ORDER BY ZONE ASC"
 
 
    Else
        lookup = "SELECT ASSESSOREMPLOYEEID, NAME, ZONE, NEED, REFERRALCOUNT, AVAILABILITY, SCHOOL "
        lookup = lookup & "FROM VIEW_ASSESSOR_AVAILABLE_GROUP "
        lookup = lookup & "GROUP BY ASSESSOREMPLOYEEID, NAME, NEED, REFERRALCOUNT, AVAILABILITY, SCHOOL,"
        lookup = lookup & "GENDER, ZONE, LICENSE, TRAIN, CREOLE, FRENCH, ITALIAN, PORTUGUESE, RUSSIAN, SPANISH "
        lookup = lookup & "HAVING "
        LOOKUP2 = IIf(Len(GENDERS) < 2, LOOKUP2, LOOKUP2 & "AND GENDER = '" & GENDERS & "' ")
        LOOKUP2 = IIf(Len(ZONES) < 2, LOOKUP2, LOOKUP2 & "AND ZONE = '" & ZONES & "' ")
        LOOKUP2 = IIf(Len(LICENSES) < 2, LOOKUP2, LOOKUP2 & "AND LICENSE = '" & LICENSES & "' ")
        LOOKUP2 = IIf(Len(TRAINS) < 2, LOOKUP2, LOOKUP2 & "AND TRAIN = '" & TRAINS & "' ")
        LOOKUP2 = IIf(Len(CreoleS) < 2, LOOKUP2, LOOKUP2 & "AND CREOLE = '" & CreoleS & "' ")
        LOOKUP2 = IIf(Len(FrenchS) < 2, LOOKUP2, LOOKUP2 & "AND French = '" & FrenchS & "' ")
        LOOKUP2 = IIf(Len(ItalianS) < 2, LOOKUP2, LOOKUP2 & "AND Italian = '" & ItalianS & "' ")
        LOOKUP2 = IIf(Len(PortugueseS) < 2, LOOKUP2, LOOKUP2 & "AND Portuguese = '" & PortugueseS & "' ")
        LOOKUP2 = IIf(Len(RussianS) < 2, LOOKUP2, LOOKUP2 & "AND Russian = '" & RussianS & "' ")
        LOOKUP2 = IIf(Len(SpanishS) < 2, LOOKUP2, LOOKUP2 & "AND Spanish = '" & SpanishS & "' ")
        SIZES = Len(LOOKUP2)
        lookup = lookup & Mid(LOOKUP2, 5, SIZES - 5)
        lookup = lookup & "ORDER BY ZONE ASC"
 
    End If
End If
 
 
 
'MsgBox lookup
If SCREENFILTER.Caption = "A" Then
    Me.SCREENFILTER.Caption = "B"
    lookup = "SELECT ASSESSOREMPLOYEEID, NAME, ZONE, NEED, REFERRALCOUNT, AVAILABILITY  FROM VIEW_ASSESSOR_AVAILABLE "
    lookup = lookup & " GROUP BY ASSESSOREMPLOYEEID, NAME, GENDER, ZONE, NEED, REFERRALCOUNT, AVAILABILITY "
    lookup = lookup & "ORDER BY ZONE ASC"
 
End If
    AssessorId.RowSource = lookup
 
Me.Text50 = lookup
End Sub
 
Private Sub TherapistId_AfterUpdate()
Dim lookup As String
Dim temprecord As Recordset
    Dim emailfind As String
Dim var As Variant
 
DoCmd.SetWarnings (False)
If IsNull(Me.TherapistId) = False Then
    lookup = "SELECT Name, Email FROM VIEW_therapist_EMAIL WHERE therapistEMPLOYEEIDs = '"
    lookup = lookup & Me.TherapistId
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
    var = temprecord.GetRows(1)
 
    TherapistName.Caption = IIf(temprecord.RecordCount <> 0, var(0, 0), " ")
    TherapistEmailName.Caption = IIf(temprecord.RecordCount <> 0, var(1, 0), " ")
End If
 
If Len(Me.oldtherapist) > 0 And IsNull(Me.TherapistId) Then
    lookup = "SELECT needperday FROM therapistneed WHERE EMPLOYID = '"
    lookup = lookup & Me.oldtherapist
    lookup = lookup & "'"
 
    Set temprecord = CurrentDb.OpenRecordset(lookup)
    If temprecord.EOF <> True Then
 
            var = temprecord.GetRows(1)
            newneed = var(0, 0) + 1
            sqlstring = "UPDATE dbo_EMPLOYEENEED "
            sqlstring = sqlstring & "SET NEEDPERDAY = " & newneed
            sqlstring = sqlstring & " WHERE THERAPISTEMPLOYEEID = '" & Me.oldtherapist & "'"
            DoCmd.RunSQL sqlstring
            MsgBox "Therapist Need has been restored"
    End If
 
ElseIf IsNull(Me.TherapistId) = False And IsNull(Me.oldtherapist) Then
                lookup = "SELECT needperday FROM therapistneed WHERE EMPLOYID = '"
                lookup = lookup & Me.TherapistId
                lookup = lookup & "'"
 
                Set temprecord = CurrentDb.OpenRecordset(lookup)
                If temprecord.EOF <> True Then
                    var = temprecord.GetRows(1)
 
                    newneed = var(0, 0) - 1
                    sqlstring = "UPDATE dbo_EMPLOYEENEED "
                    sqlstring = sqlstring & "SET NEEDPERDAY = " & newneed
                    sqlstring = sqlstring & " WHERE THERAPISTEMPLOYEEID = '" & Me.TherapistId & "'"
                    DoCmd.RunSQL sqlstring
                    MsgBox "Therapist Need has been reduced"
                End If
ElseIf IsNull(Me.TherapistId) = False And Me.oldtherapist <> Me.TherapistId Then
                lookup = "SELECT needperday FROM therapistneed WHERE EMPLOYID = '"
                lookup = lookup & Me.oldtherapist
                lookup = lookup & "'"
 
                Set temprecord = CurrentDb.OpenRecordset(lookup)
                If temprecord.EOF <> True Then
                    var = temprecord.GetRows(1)
 
                    newneed = var(0, 0) + 1
                    sqlstring = "UPDATE dbo_EMPLOYEENEED "
                    sqlstring = sqlstring & "SET NEEDPERDAY = " & newneed
                    sqlstring = sqlstring & " WHERE THERAPISTEMPLOYEEID = '" & Me.oldtherapist & "'"
                    DoCmd.RunSQL sqlstring
                End If
                lookup = "SELECT needperday FROM therapistneed WHERE EMPLOYID = '"
                lookup = lookup & Me.TherapistId
                lookup = lookup & "'"
 
                Set temprecord = CurrentDb.OpenRecordset(lookup)
                If temprecord.EOF <> True Then
                    var = temprecord.GetRows(1)
 
                    newneed = var(0, 0) - 1
                    sqlstring = "UPDATE dbo_EMPLOYEENEED "
                    sqlstring = sqlstring & "SET NEEDPERDAY = " & newneed
                    sqlstring = sqlstring & " WHERE THERAPISTEMPLOYEEID = '" & Me.TherapistId & "'"
                    DoCmd.RunSQL sqlstring
                End If
            MsgBox Me.oldtherapist & " need has been increase by 1 and " & Me.TherapistId & " need has been reduced by 1"
        End If
End Sub
 
Private Sub TherapistId_Enter()
Dim LICENSES As String
Dim TRAINS As String
Dim CreoleS  As String
Dim FrenchS As String
Dim ItalianS As String
Dim PortugueseS As String
Dim RussianS As String
Dim SpanishS As String
Dim GENDERS As String
 
DoCmd.SetWarnings (False)
 
ZONES = IIf(IsNull(ServiceZoneID), "", Me.ServiceZoneID)
 
If IsNull(Me.LicensedRequired) Then
    LICENSES = ""
Else
    LICENSES = IIf(Me.LicensedRequired = 0, "", "YES")
End If
 
If IsNull(Me.SafetyTrainingRequired) And IsNull(Me.StaartTrainingRequired) Then
    TRAINS = ""
Else
    TRAINS = IIf((Me.SafetyTrainingRequired + Me.StaartTrainingRequired) < 1, "", "YES")
End If
 
If IsNull(Me.GenderRequirements) Then
    GENDERS = ""
Else
    GENDERS = IIf(Me.GenderRequirements = "FEMALE", "FEMALE", "MALE")
End If
 
CreoleS = IIf(Me.LanguageServices = "Creole", "YES", "")
FrenchS = IIf(Me.LanguageServices = "French", "YES", "")
ItalianS = IIf(Me.LanguageServices = "Italian", "YES", "")
PortugueseS = IIf(Me.LanguageServices = "Portuguese", "YES", "")
RussianS = IIf(Me.LanguageServices = "Russian", "YES", "")
SpanishS = IIf(Me.LanguageServices = "Spanish", "YES", "")
 
If Me.SCREENFILTER.Caption = "B" Then
    If IsNull(School) = False Then
    lookup = "SELECT THERAPISTEMPLOYEEID, NAME, ZONE, NEED, SCHOOL "
    lookup = lookup & "FROM VIEW_SELECTTHERAPISTWITHSCHOOL "
    lookup = lookup & "GROUP BY THERAPISTEMPLOYEEID, NAME, GENDER, ZONE, NEED, SCHOOL,"
        lookup = lookup & "GENDER, ZONE, LICENSE, TRAIN, CREOLE, FRENCH, ITALIAN, PORTUGUESE, RUSSIAN, SPANISH "
        lookup = lookup & "HAVING "
        lookup = lookup & "SCHOOL='" & Me.School & "' "
        lookup = IIf(Len(GENDERS) < 2, lookup, lookup & "AND GENDER = '" & GENDERS & "' ")
        lookup = IIf(Len(ZONESS) < 2, lookup, lookup & "AND ZONE = '" & ZONES & "' ")
        lookup = IIf(Len(LICENSES) < 2, lookup, lookup & "AND LICENSE = '" & LICENSES & "' ")
        lookup = IIf(Len(TRAINS) < 2, lookup, lookup & "AND TRAIN = '" & TRAINS & "' ")
        lookup = IIf(Len(CreoleS) < 2, lookup, lookup & "AND CREOLE = '" & CreoleS & "' ")
        lookup = IIf(Len(FrenchS) < 2, lookup, lookup & "AND French = '" & FrenchS & "' ")
        lookup = IIf(Len(ItalianS) < 2, lookup, lookup & "AND Italian = '" & ItalianS & "' ")
        lookup = IIf(Len(PortugueseS) < 2, lookup, lookup & "AND Portuguese = '" & PortugueseS & "' ")
        lookup = IIf(Len(RussianS) < 2, lookup, lookup & "AND Russian = '" & RussianS & "' ")
        lookup = IIf(Len(SpanishS) < 2, lookup, lookup & "AND Spanish = '" & SpanishS & "' ")
lookup = lookup & "ORDER BY ZONE ASC"
 
    Else
    lookup = "SELECT THERAPISTEMPLOYEEID, NAME, ZONE, NEED, SCHOOL "
        lookup = lookup & "FROM VIEW_THERAPIST_AVAILABLE_GROUP "
        lookup = lookup & "GROUP BY THERAPISTEMPLOYEEID, NAME, NEED, SCHOOL,"
        lookup = lookup & "GENDER, ZONE, LICENSE, TRAIN, CREOLE, FRENCH, ITALIAN, PORTUGUESE, RUSSIAN, SPANISH "
        lookup = lookup & "HAVING "
        LOOKUP2 = IIf(Len(GENDERS) < 2, LOOKUP2, LOOKUP2 & "AND GENDER = '" & GENDERS & "' ")
        LOOKUP2 = IIf(Len(ZONES) < 2, LOOKUP2, LOOKUP2 & "AND ZONE = '" & ZONES & "' ")
        LOOKUP2 = IIf(Len(LICENSES) < 2, LOOKUP2, LOOKUP2 & "AND LICENSE = '" & LICENSES & "' ")
        LOOKUP2 = IIf(Len(TRAINS) < 2, LOOKUP2, LOOKUP2 & "AND TRAIN = '" & TRAINS & "' ")
        LOOKUP2 = IIf(Len(CreoleS) < 2, LOOKUP2, LOOKUP2 & "AND CREOLE = '" & CreoleS & "' ")
        LOOKUP2 = IIf(Len(FrenchS) < 2, LOOKUP2, LOOKUP2 & "AND French = '" & FrenchS & "' ")
        LOOKUP2 = IIf(Len(ItalianS) < 2, LOOKUP2, LOOKUP2 & "AND Italian = '" & ItalianS & "' ")
        LOOKUP2 = IIf(Len(PortugueseS) < 2, LOOKUP2, LOOKUP2 & "AND Portuguese = '" & PortugueseS & "' ")
        LOOKUP2 = IIf(Len(RussianS) < 2, LOOKUP2, LOOKUP2 & "AND Russian = '" & RussianS & "' ")
        LOOKUP2 = IIf(Len(SpanishS) < 2, LOOKUP2, LOOKUP2 & "AND Spanish = '" & SpanishS & "' ")
        SIZES = Len(LOOKUP2)
        lookup = lookup & Mid(LOOKUP2, 5, SIZES - 5)
        lookup = lookup & "ORDER BY ZONE ASC"
 
    End If
End If
 
 
 
 
'MsgBox lookup
If SCREENFILTER.Caption = "A" Then
 
    Me.SCREENFILTER.Caption = "B"
    lookup = "SELECT THERAPISTEMPLOYEEID, NAME, ZONE, NEED FROM VIEW_THERAPIST_AVAILABLE "
    lookup = lookup & " GROUP BY THERAPISTEMPLOYEEID, NAME, GENDER, ZONE, NEED"
        lookup = lookup & " ORDER BY ZONE ASC"
 
End If
    TherapistId.RowSource = lookup
 
Me.Text50 = lookup
 
End Sub
 
 
 

[Rabbit]

I'm not talking about the code, you've already shown us the code. I mean the actual string it is trying to put into the Filter.

[W4FF]

Rabbit I'm not a pro at this and where would I find the actual string it is trying to put into the Filter?

[Rabbit]

You can put a debug.print or msgbox after you build the string.

[Stewart Ross]

Line 169, the replacement you made following on from what I suggested, is still in error. You have to have spaces on either side of the AND keyword, which you have left out:

filterstr = filterlast & " AND " & filterfirst & " AND " & filterssn & "AND" & filterdob

It is essential that the spaces be included, as they were in my answer to you:

filterstr = filterlast & " AND " & filterfirst & " AND " & filterssn & " AND " & filterdob

-Stewart

[W4FF]

Yes I did add spaces, and I still get an overflow error. By the way thank you both for your help, I'm truly grateful.

[Stewart Ross]

Use the Debug option to find out what line the overflow is occurring on. Overflow errors can result from division of a number by zero, or from using a type such as integer with a value that cannot be contained in that type (e.g. a positive number greater than 32767 in the case of an integer). Without knowing the circumstances it is difficult to advise on this one.

-Stewart

[zmbd]

Code Block Post#5
Lines:
184. End If
185. Me.Referral.Form.Filter = filterstr

Change to:
184. End If
(184a) debug.print filterstr
(184b) stop
185. Me.Referral.Form.Filter = filterstr

Now run.
Once the debugger stops on the command at 184b press <ctrl><g> to open the immediate window and you should see the resolved string from "filterstr"

[W4FF]

When I press <ctrl><g> I get the following from the window: LastName Like '*Mike*'

Do you think this might cause the overflow issue?

[Stewart Ross]

From what you have posted, the short answer is that the overflow does not result from the application of that filter.

Overflows result from numeric issues - division by zero or exceeding the number of digits that can be stored in a numeric value. We'd still need you to use the debugger when the overflow occurs and note where in your code it is erroring.

-Stewart

[Rabbit]

When you restart the code from the break point, does it give you the error?