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

Ok, you still need End Date. You need to use the value from the End Date textbox to check against the Start Date field in your table. Makes sense?
 
First sorry for my late response. I've been delivering training today and will be again tomorrow so can't always respond when I would like to.

Yes you are making sense. I think we're both on the same page although you express it better than me because you know what you are talking about.

I'll take a look at the code and see if that helps me to apply your advice from the previous mail.

Thanks for both your time and patience.

If I get this in to any sort of shape I'll put a copy of the dbase on here with some fake data so that you aren't bothered with idiots like me in the future. Even if what I post only serves as a warning to others about the approach that I have taken.

Guinness
 
You know where we are if you're stuck.
 
I'm back to getting a syntax error when I add Trainer_Name

Do I need to set up some sort of Dim? Something like
Code: 
 Dim strTrainer_Name as string
Here's what I'm attempting to run:

Code: 
 Private Sub Form_BeforeUpdate(Cancel As Integer)
 Dim intCheck As Integer
    Dim strDuration As String
    Dim strCondition As String
    Dim strMessage As String
    Dim intResponse As Byte
    
    Const BTWN_DATES As String = " BETWEEN [Start_Date] AND [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 = "(#" & Me.Start_Date & "#" & BTWN_DATES & strDuration & Trainer_Name & ")" & _
                   " OR " & _
                   "(#" & Me.End_Date & "#" & BTWN_DATES & strDuration & Trainer_Name & ")"
    
    intCheck = DCount("*", "[Resourcing]", strCondition)
    
    If intCheck > 0 Then
        Cancel = True
        
        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
    End If
End Sub
 
It's a bit late in the day to think of this but could a find duplicates query have been amended to do this or is that just the same as using indexes in the resourcing table?
 
You could create a query that finds the duplicates by putting the right parameters into the criteria but it's the same thing as what we're doing. The only difference is it will make the code look cleaner.
 
So close....

I did the
Code: 
Dim strTrainer_Name as string
and amended the str condition to:
Code: 
 strCondition = "(#" & Me.Start_Date & "#" & BTWN_DATES & strDuration & strTrainer_Name & ")" & _
                   " OR " & _
                   "(#" & Me.End_Date & "#" & BTWN_DATES & strDuration & strTrainer_Name & ")"
The problem is that when I entered hours it came up with the append records message followed by the duplicates warning even though I wasn't creating a duplicate. It did however create the records. So I think there is something in the order of events. I know that I have it in the before update but it seems to be running the update and then saying the records are duplicates. If you don't mind pasting this code into the trial version that I sent you'll see what I mean

Code: 
 Private Sub Form_BeforeUpdate(Cancel As Integer)
 Dim intCheck As Integer
    Dim strDuration As String
    Dim strTrainer_Name As String
    Dim strCondition As String
    Dim strMessage As String
    Dim intResponse As Byte
    
    Const BTWN_DATES As String = " BETWEEN [Start_Date] AND [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 = "(#" & Me.Start_Date & "#" & BTWN_DATES & strDuration & strTrainer_Name & ")" & _
                   " OR " & _
                   "(#" & Me.End_Date & "#" & BTWN_DATES & strDuration & strTrainer_Name & ")"
    
    intCheck = DCount("*", "[Resourcing]", strCondition)
    
    If intCheck > 0 Then
        Cancel = True
        
        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
    End If
End Sub
 
You don't need to post the entire function again. Only post relevant parts, helps to keep the post short. I'm amending the code as we speak.
 
Code: 
    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
 
Apologies

I just thought it would save you some work.

I'm also wondering if the following should be changed to:

Code: 
 strMessage = "This event clashes with" & IIf(intCheck [B][COLOR=red]= 1[/COLOR][/B], " an ", " ") & _
                              "existing event" & IIf(intCheck > 1, "s", "") & _
                     vbNewLine & vbNewLine & _
                     "Do you wish to view and edit the event" & IIf(intCheck > 1, "s?", "?")
 
guinness said:
Code: 
 strMessage = "This event clashes with" & IIf(intCheck [B][COLOR=red]= 1[/COLOR][/B], " an ", " ") & _
                              "existing event" & IIf(intCheck > 1, "s", "") & _
                     vbNewLine & vbNewLine & _
                     "Do you wish to view and edit the event" & IIf(intCheck > 1, "s?", "?")
Click to expand...
If you're wondering go ahead and give it a try to see if it makes a difference. That's how you learn.

Anyway that's just aesthetics.
If there's 1 clash it will read:
Code: 
This event clashes with [COLOR="red"]an[/COLOR] existing event
If there's more than 1 clash it will read:
Code: 
This event clashes with existing event[COLOR="Red"]s[/COLOR]
 
I'm almost scared to tell you this. With the new code it let me enter a set of new records as it should. But then I entered a duplicate record for one of the dates and it allowed me to. :(
 
How is the record saved? Where's the code for that.

Actually let me see the full code to be sure that you replaced the right parts.
 
The records are saved using the 'Create Records button which has code behind it which may be clashing.

The code at present looks like this
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
        Cancel = True
        
        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
    End If
End Sub
 
Code: 
 Private Sub Create_multiple_records_Click()
 Dim strSQL As String
 'As you are entering the first record manually with the end date the sql only addes the dates greater than the first date
 'This only works where all fields are filled in - you should probably build in a check to see if the Trainer and the Date are accounted for already
'dlookup("Trainer_Name", "Resourcing", "Trainer_Name = " & [Forms]![Resourcing]![Cmb_Trainer_Name] & " and StartDate = " & [the dates])
 'If you can omit data from a field then you will have to breakdown the sql statement to omit the data if null - example for the  field  "Activity" - you would also remove the validation for Null Field
 'Validate fields are not Null
 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
      'build the SQL Statement
      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]))"
      'Run the SQL Statement
      DoCmd.RunSQL (strSQL)
      
End If
'To show the project title description in the activity box:
 Activity = Activity & ": " & [Forms]![Resourcing]![Project_Title]
 'To go to a new record
 
Me.Requery
  
 DoCmd.GoToRecord , , acNewRec
 
 
'To requery the resourcing form and refresh the Edit Hours form
 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
 
Private Sub New_Record_Click()
On Error GoTo Err_New_Record_Click
 
    DoCmd.GoToRecord , , acNewRec
 Exit_New_Record_Click:
    Exit Sub
 Err_New_Record_Click:
    MsgBox Err.Description
    Resume Exit_New_Record_Click
    
End Sub
 
Ultimately your probably lies here:
Code: 
DoCmd.RunSQL (strSQL)
If you save a record via code in this fashion the Before Update event will not fire.
 
But how can I get round that? Running the sql is what creates the multiple records. If this is stupid idea please say so but Could Ipaste your code in it's entirety before the DoCmd.RunSql?????
 
First of all, create a new Sub (call it whatever you want to call it - obviously something meaningful) and paste my code into it. Once that done show me the full code and we go from there.

By the way, does the save record code definitely do what it's supposed to do?
 
The save record sql creates the records. That I have tried and tested.

So I tried putting your code into the multiple records code. When I click the button though absolutely nothing happens. No warnings, no debugger etc. Also when I try to compile the database I get and error with
Code: 
Cancel =
So here's what I tried in its entirety:
Code: 
 Private Sub Create_multiple_records_warn_about_duplicates_Click()
 Dim intCheck        As Integer
    Dim strSQL          As String
    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
        Cancel = True
        
        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
        
        ElseIf 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
      
      strSQL = "INSERT INTO Resourcing ( Start_Date, Duration, Project_Title, Trainer_Name, Team"
      If Not IsNull(Me.Cmb_Activity) Then
            strSQL = strSQL & ", Activity"
      End If
      End If
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
 
You must log in or register to reply here.

Similar threads

C
Getting a write conflict
Replies
6
Views
443
ChrisLeicester
C
R
Solved Dreaded 'Write Conflict' error after adding a new field to Access form
Replies
12
Views
1,047
ricardocpa
R
A
Order entry and tracking system
2 3
Replies
44
Views
4,126
Pat Hartman
P
C
Help with my Keypad
Replies
5
Views
626
ChrisLeicester
C
C
Solved Error 3021: No Current record
Replies
2
Views
265
Consonanza
C

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom