Warn about conflicting entries and offer choice to edit conflicting entry or current

[guinness]

Forgot to say but the compile error is Variable not defined

 

[vbaInet]

That's a pretty long name for a Sub. I would call it:

Public Sub DuplicatesCheck()

End Sub

In any case, I did say to paste only my code in there. So please do that, paste the entire code again and we'll go from there.

 

[guinness]

Done

My head hurts

 

[vbaInet]

What did you call the function?

 

[guinness]

Public Sub DuplicatesCheck()

Sorry was away from the PC for a while as the wife threatened to divorce me if I didn't take a break

 

[vbaInet]

Tell the wife that your life depends on this

Change that Sub to a function, like so:

Public Function DuplicatesCheck() As Boolean

End Function

And call it here:

[COLOR="Blue"]       If DuplicatesCheck = False Then
            Exit Sub
       End If[/COLOR]
       'build the SQL Statement
      strSQL = "INSERT INTO Resourcing ( Start_Date, Duration, Project_Title, Trainer_Name, Team"

I was going to re-write your code but I don't have the energy.

By the way, that's not the end of it so don't test it yet.

 

[guinness]

Thank you so mch for the time that you have spent on this. As I said I was away from my PC so am just getting to this now.

So I've created a module and put the function in. Then I've pasted the duplicates code into the the multiple records code called by the button. As you suggested I haven't done anything else yet.

Thanks for this

 

[guinness]

I've names the module DuplicatesCheck

 

[vbaInet]

Remove this line of code from my code:

Cancel = True

Add the lines in blue to my code:

        If intResponse = vbYes Then
            DoCmd.OpenForm "Edit Hours", , , strCondition
        End If
[COLOR="Blue"]    Else
        DuplicatesCheck = True[/COLOR]
    End If

Now Debug > Compile then give it a test run.

 

[guinness]

I'm getting a compile error on the 'Create_multiple_Records' code.

The line is

 If DuplicatesCheck = False Then

The compile error is type mismatch and the = symbol is highlighted

 

[vbaInet]

Did you do what I asked you to do here?

Change that Sub to a function, like so:

Public [COLOR="Red"]Function DuplicatesCheck() As Boolean[/COLOR]

End Function

 

[vbaInet]

I've names the module DuplicatesCheck

And did you actually call the module itself DuplicatesCheck? If it's the Module, call it mdlDuplicatesCheck.

 

[guinness]

Yep I created the module and pasted the code. I've renamed it mdlDuplicatesCheck as you suggest.

I went to debug then compile and got a new compile error. This time it's on the line from the before update code

  DuplicatesCheck = True

. Duplicates check= is highlighted and the error is 'function call on left hand side of assignment must return variable or object'

 

[vbaInet]

You've not set things up right. Let me see both functions.

 

[guinness]

do you want me to paste the before update code and the multiple records code in full?

 

[vbaInet]

Yes please.

 

[guinness]

before update code

 Private Sub Form_BeforeUpdate(Cancel As Integer)
  Dim intCheck        As Integer
    Dim strDates        As String
    Dim strDuration     As String
    Dim strTrainer      As String
    Dim strCondition    As String
    Dim strMessage      As String
    Dim intResponse     As Byte
    
    strTrainer = "[Trainer_Name] = '" & Me.Trainer_Name & "'"
    
    strDates = " AND [Start_Date] IN (#" & Me.Start_Date & "#,#" & Me.End_Date & "#)"
    
    If Me.Duration = "All Day" Then
        strDuration = " AND Not [Duration] Is Null"
    Else
        strDuration = " AND [Duration] IN ('All Day','" & Me.Duration & "')"
    End If
    
    strCondition = strTrainer & strDates & strDuration
    
    intCheck = DCount("*", "[Resourcing]", strCondition)
    
    If intCheck > 0 Then
       
        
        strMessage = "This event clashes with" & IIf(intCheck = 1, " an ", " ") & _
                              "existing event" & IIf(intCheck > 1, "s", "") & _
                     vbNewLine & vbNewLine & _
                     "Do you wish to view and edit the event" & IIf(intCheck > 1, "s?", "?")
        
        intResponse = MsgBox(strMessage, vbYesNo + vbQuestion, "Event clash do you wish to edit the existing event")
        
        If intResponse = vbYes Then
            DoCmd.OpenForm "Edit Hours", , , strCondition
        End If
         Else
        DuplicatesCheck = True
     End If
End Sub

Multiple records code

 Private Sub Create_multiple_records_Click()
 Dim strSQL As String
 If IsNull(Me.Start_Date) Then
      MsgBox "Start Date Missing", vbOKOnly + vbCritical, "Error"
      Me.Start_Date.SetFocus
ElseIf IsNull(Me.End_Date) Then
      MsgBox "End Date Missing", vbOKOnly + vbCritical, "Error"
      Me.End_Date.SetFocus
ElseIf IsNull(Me.Cmb_Activity) Then
      MsgBox "Activity Missing", vbOKOnly + vbCritical, "Error"
      Me.Cmb_Activity.SetFocus
ElseIf IsNull(Me.Cmb_Duration) Then
      MsgBox "Duration Missing", vbOKOnly + vbCritical, "Error"
      Me.Cmb_Duration.SetFocus
Else
      If DuplicatesCheck = False Then
            Exit Sub
       End If
       strSQL = "INSERT INTO Resourcing ( Start_Date, Duration, Project_Title, Trainer_Name, Team"
      If Not IsNull(Me.Cmb_Activity) Then
            strSQL = strSQL & ", Activity"
      End If
      
      strSQL = strSQL & ", Training_Type ) "
      strSQL = strSQL & " SELECT Dates.Work_Dates, [Forms]![Resourcing]![Cmb_Duration] AS Expr1, [Forms]![Resourcing]![Cmb_Project_Title] AS Expr2, [Forms]![Resourcing]![Cmb_Trainer_Name] AS Expr3, [Forms]![Resourcing]![Cmb_Team] AS Expr4"
      
      If Not IsNull(Me.Cmb_Activity) Then
            strSQL = strSQL & " , [Forms]![Resourcing]![Cmb_Activity] AS Expr5"
      End If
      strSQL = strSQL & " , [Forms]![Resourcing]![Cmb_Training_Type] AS Expr6 "
      
      strSQL = strSQL & " FROM Dates WHERE (((Dates.Work_Dates)>[Forms]![Resourcing]![Start_Date] And (Dates.Work_Dates)<=[Forms]![Resourcing]![End_Date]))"
           DoCmd.RunSQL (strSQL)
      
End If

 Activity = Activity & ": " & [Forms]![Resourcing]![Project_Title]
 
Me.Requery
  
 DoCmd.GoToRecord , , acNewRec
 
 
If CurrentProject.AllForms("2014 Resources").IsLoaded Then
[Forms]![2014 Resources].Requery
If CurrentProject.AllForms("Edit Hours").IsLoaded Then
 [Forms]![Edit Hours].Refresh
 End If
End If
 End Sub

 

[vbaInet]

I thought my explanations were clear enough.

You need to cut the code I wrote for you and paste it inside the DuplicatesCheck function. There should be nothing in the Before Update event. Once you've done that, paste the whole thing here.

 

[guinness]

 Public Function DuplicatesCheck() As Boolean
  Dim intCheck        As Integer
    Dim strDates        As String
    Dim strDuration     As String
    Dim strTrainer      As String
    Dim strCondition    As String
    Dim strMessage      As String
    Dim intResponse     As Byte
    
    strTrainer = "[Trainer_Name] = '" & Me.Trainer_Name & "'"
    
    strDates = " AND [Start_Date] IN (#" & Me.Start_Date & "#,#" & Me.End_Date & "#)"
    
    If Me.Duration = "All Day" Then
        strDuration = " AND Not [Duration] Is Null"
    Else
        strDuration = " AND [Duration] IN ('All Day','" & Me.Duration & "')"
    End If
    
    strCondition = strTrainer & strDates & strDuration
    
    intCheck = DCount("*", "[Resourcing]", strCondition)
    
    If intCheck > 0 Then
       
        
        strMessage = "This event clashes with" & IIf(intCheck = 1, " an ", " ") & _
                              "existing event" & IIf(intCheck > 1, "s", "") & _
                     vbNewLine & vbNewLine & _
                     "Do you wish to view and edit the event" & IIf(intCheck > 1, "s?", "?")
        
        intResponse = MsgBox(strMessage, vbYesNo + vbQuestion, "Event clash do you wish to edit the existing event")
        
        If intResponse = vbYes Then
            DoCmd.OpenForm "Edit Hours", , , strCondition
        End If
         Else
        DuplicatesCheck = True
     End If
 End Function

I'll say in advance I gave it a quick try and got a compile error 'invalid use of Me' on strTrainer = "[Trainer_Name] = '" & Me.Trainer_Name & "'"

 

[guinness]

It's just as well we use nicnames on here or you would probably find me and kill me