Warn about conflicting entries and offer choice to edit conflicting entry or current (1 Viewer)

[guinness]

Hi All

I'm hoping someone can help me with some code to handle duplicate/conflicting entries. I am creating a resourcing database. Staff are scheduled for either AM, PM or All day for each date using a Form ("Resourcing"). The fields on the form are [Start_Date], [End_Date] and [Duration] (ALL Day, AM, PM). At the moment if I attempt to book someone All day for a date that is already populated it simply creates another entry with the same date in the table ("Resourcing").

Worse still I display the data using a crosstab ("2014 Resources"). Column 1 = Name, Collumn 2 shows Duration (AM, PM AND All Day). Work_Dates is the Column Header and Activity is the Value for the crosstab. When I create a duplicate value it doesn't even show on the crosstab.

What I am looking for is code to add to the form ("Resourcing") that checks the table ("Resourcing") and checks the following:

If there is an entry for All Day and the user tries to input anything then offer choice to amend details of present entry or discard this entry and open form ("Edit Hours")

If there is an entry for AM and the user enters an entry for PM continue

If there is an entry for AM and the user tries to enter AM or All day then offer choice to amend details of present entry or discard this entry and open form ("Edit Hours")

If there is an entry for PM and the user enters an entry for AM continue

If there is an entry for PM and the user tries to enter AM or All day then offer choice to amend details of present entry or discard this entry and open form ("Edit Hours")

Any help with this would be much appreciated.

Thanks
Guinness

 

[BlueIshDan]

First a question: Are you able to code this yourself and are looking to get help with the code, or are you looking for someone to develop this for you?

If you are looking for help with coding this, please provide some of the code that you currently have. This will help us see where you stand and provide some clarity of where we need to focus.

(for some of us code speaks more clearly to us than humans lol)

 

[guinness]

Hi BlueIshDan

I seriously wish I could write the code myself but I haven't a clue where to start. The only bits and pieces of code I have picked up are from reverse engineering code found online, created automatically by macros or sourced by the good folks on here.

So I suppose I'm really hoping that someone can either write the code for me or point me to a similar piece of code that has been written that I can then amend with my tables, queries, fields etc.

Thanks for getting back to me

Guinness

 

[BlueIshDan]

Well in that case, it would be extremely helpful for us if you provided your code thus far.

 

[guinness]

Hi BlueIshDan

Here's all the code already attached to the form in question. As I said though I have no idea where to start with the code to check for conflicts so have no code to show you. As I said before I would need someone to write the code for me or provide an example of something similar that I could reverse engineer to suit my needs.

Option Compare Database
Option Explicit
 

Private Sub Cmb_Trainer_Name_AfterUpdate()
Me.Cmb_Team.Requery
End Sub
Private Sub Cmb_Training_Type_AfterUpdate()
Me.Cmb_Project_Title.Requery
End Sub
Private Sub Create_multiple_records_Click()
Dim strSQL As String
[EMAIL="'Gerry@docshop.ie"]'Gerry@docshop.ie[/EMAIL] created the code to create multiple records
'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
'From here on it's my own stuff
'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

 

[BlueIshDan]

Could you give me information on your tables' structures and how the two tables Resources and Dates are related?

 

[guinness]

Thanks for showing an interest BlueIshDan

I don't know if the attached image Picture 1.png might help. It's the design view of my crosstab query and shows all of the fields from the Resources table and the dates table which litterally is just a list of working days from 02/01/2014-31/10/2017.

Picture 2.png shows the Resources form used to enter the data as a pop up over the form that visually displays the data.

Let me know if you need more detail.

Cheers

Guinness

 

[BlueIshDan]

Going out to lunch. I'll be back within the hour!

 

[vbaInet]

Not butting in but was just going to say why don't you sort out the issue about double booking in your table first?

List out all the fields in the Resourcing table and indicate which fields constitute a double booking. Include their data types as well.

 

[guinness]

Hello again vbInet

For once I'm ahead of you but lack your skill.

It did occur to me that if I created a unique field based on other fields then I could prevent duplicates within the table i.e. Joe blogs is resourced for AM on 01012014. Create a unique entry like jba01012014. Creating the same format for All Day would prevent an AM appointment being booked if an all day appointment had and vice versa. Not sure how to handle PM though.

Also not sure how to create this unique code automatically.

 

[vbaInet]

For once I'm ahead of you but lack your skill.

It did occur to me that if I created a unique field based on other fields then I could prevent duplicates within the table i.e. Joe blogs is resourced for AM on 01012014. Create a unique entry like jba01012014.

I'm still ahead of you on this one!

A separate field is not required, you just create composite keys in your table. Set all three fields to be the Primary Key. If one attempts to enter the same combination of Name/Date Access will complain. It's one option, but you can continue working on doing it in the form instead.

 

[guinness]

Of course you're ahead of me on not only this one but on every one

The problem I'm struggling with, with this approach is that there are three variables. You can't book an all day if there is already an AM or a PM but you can book an AM and a PM on the same day.

So date can't be a primary key as there could be two records with the same date.

Help!!!!!

 

[guinness]

Also I don't just want to create an error, I want to offer a choice of solution; either edit the record that you are creating or open the edit hours table and edit or remove the existing record

 

[vbaInet]

If there's a range then the composite keys won't work. I wasn't following your entire thread, I just threw an idea to see if it will help

I'll come back to it, read through the entire thread and give proper solutions when I have more time.

 

[guinness]

Thanks vbaInet

As you are more aware than most I need all the help I can muster

 

[guinness]

Hi Guys

I got some air code to get me started but the person who wrote this for me is offline and I'm struggling to adapt it. At the moment I can't even test it as VBA does not like the ElseIf statements in the last block of the code.

Can any of you guys have a look over this and point me in the right direction?

Private Sub Form_BeforeUpdate(Cancel As Integer)
Function ISITOK(Trainer_Name, Start_Date, NewRec)
Dim NewRec As Long
NewRec = 0
Valchek = ISITOK(Me.Trainer_Name, Me.Start_Date, NewRec)
Dim strVal As String
Dim Am As String
Dim PM As String
Dim Allday As String
Am = "N"
PM = "N"
All Day = "N"
strSQL = "Select TimePArt from tblWork where Person = " & Me.Trainer_Name & " and Start_Date = #" & Me.Start_Date & "#"
If rs.EOF Then i
ISITOK = "NNN"
Exit Function
With rs
Do Until .EOF
If !timepart = "AM" Then
Am = "Y"
NewRec = ![PKField]
End If
If !timepart = "PM" Then
PM = "Y"
NewRec = ![PKField]
End If
If !Yimepart = "All Day" Then
All Day = "Y"
NewRec = ![PKField]
End If
.MoveNext
Loop
ISITOK = Am & PM & "All Day"
Exit Function
Select Case Valcheck
Case "NNN"
Exit Sub
Case "YNN"
If Me.timepart = "All Day" Then
MsgBox "Trainer already booked.  Do you want to amend the existing record?  No will discard this one."
Me.Recordset.FindFirst "PKField] = " & NewRec
ElseIf me.timepart = "AM"
End If
Case "NYN"
If Me.timepart = "All Day" Then
MsgBox "Trainer already booked.  Do you want to amend the existing record?  No will discard this one."
Me.Recordset.FindFirst [PKField] = " & NewRec"
ElseIf me.timepart = "PM"
End If
Case "NNY"
If Me.timepart = "All Day" Then
MsgBox "Trainer already booked.  Do you want to amend the existing record?  No will discard this one."
Me.Recordset.FindFirst [PKField] = " & NewRec
ElseIf me.timepart = "All Day"
End If
End Function
 
End Function

 

[vbaInet]

I had almost completed writing some aircode on my laptop when Access crashed. I'll get back to it and send.

 

[guinness]

Thanks vbaInet

Your a star.

I really appreciate it.

Guinness

 

[guinness]

Think I've sorted out my issue with the ElseIf sataements in the final block but I'm still doing something wrong. It seems to want End Sub as the second line before the function runs. I'm also worried that it automatically Keeps changing AM to Am

Private Sub Form_BeforeUpdate(Cancel As Integer)
Function ISITOK(Trainer_Name, Start_Date, NewRec)
Dim NewRec As Long
NewRec = 0
Valchek = ISITOK(Me.Trainer_Name, Me.Start_Date, NewRec)
Dim strVal As String
Dim Am As String
Dim PM As String
Dim Allday As String
Am = "N"
PM = "N"
All Day = "N"
strSQL = "Select TimePArt from tblWork where Person = " & Me.Trainer_Name & " and Start_Date = #" & Me.Start_Date & "#"
If rs.EOF Then i
ISITOK = "NNN"
Exit Function
With rs
Do Until .EOF
If !timepart = "AM" Then
Am = "Y"
NewRec = ![PKField]
End If
If !timepart = "PM" Then
PM = "Y"
NewRec = ![PKField]
End If
If !Yimepart = "All Day" Then
All Day = "Y"
NewRec = ![PKField]
End If
.MoveNext
Loop
ISITOK = Am & PM & "All Day"
Exit Function
Select Case Valcheck
Case "NNN"
Exit Sub
Case "YNN"
If Me.timepart = "All Day" Then
MsgBox "Trainer already booked.  Do you want to amend the existing record?  No will discard this one."
ElseIf Me.timepart = "AM" Then
Me.Recordset.FindFirst [PKField] = " & NewRec
End If
Case "NYN"
If Me.timepart = "All Day" Then
MsgBox "Trainer already booked.  Do you want to amend the existing record?  No will discard this one."
ElseIf Me.timepart = "PM" Then
Me.Recordset.FindFirst [PKField] = " & NewRec"
End If
Case "NNY"
If Me.timepart = "All Day" Then
MsgBox "Trainer already booked.  Do you want to amend the existing record?  No will discard this one."
ElseIf Me.timepart = "All Day" Then
Me.Recordset.FindFirst [PKField] = " & NewRec
End If
End Function
End Sub

 

[vbaInet]

I can't read your code but I can see "End Function" and "End Sub together". It's one or the other.