Recordset rs.Find return results

[nspader]

In my database I have a varying amount of thins set up. I am trying to display multiple shifts for each day of the month in a calendar form.

I have the calendar set up properly to display the days. I have the correct information generated in table.

I am having trouble displaying multiple records. Right now it only displays one record. Either the first, last or next or whatever I call.

I will include the code below for the section where it occurs. Any help would be appreciated. I am stumped on this one.

Public Sub PutInData()
Dim SQL As String
Dim f As Form
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyDate As Date
Dim i As Integer
 
Set f = Forms!frmCalendar
 
    For i = 1 To 37
        f("text" & i) = Null
    Next i
 
    SQL = "SELECT * FROM [qryShifts] WHERE ((MONTH(ShiftDetailDate) = " & f!month & " AND YEAR(ShiftDetailDate) = " & f!year & ")) ORDER BY tblShiftDetail.ShiftDetailDate, tblShiftDetail.ShiftNumber, tblEmployee.EmployeeNumber;"
 
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(SQL)
 
    If rs.RecordCount > 0 Then
        For i = 1 To 37
            If IsDate(f("date" & i)) Then
                MyDate = Format((f("date" & i)), "mm/dd/yyyy")
                rs.FindFirst ("ShiftDetailDate = #" & MyDate & "#")
                    If Not rs.NoMatch Then
                        f("text" & i) = rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & rs!ShiftStartTime & "-" & rs!ShiftEndTime
                    End If
            End If
        Next i
    End If
 
    rs.Close
    Set rs = Nothing
    Set db = Nothing
 
End Sub
 

Thank you
Nick

[ADezii]

In my database I have a varying amount of thins set up. I am trying to display multiple shifts for each day of the month in a calendar form.

I have the calendar set up properly to display the days. I have the correct information generated in table.

I am having trouble displaying multiple records. Right now it only displays one record. Either the first, last or next or whatever I call.

I will include the code below for the section where it occurs. Any help would be appreciated. I am stumped on this one.

Public Sub PutInData()
Dim SQL As String
Dim f As Form
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyDate As Date
Dim i As Integer
 
Set f = Forms!frmCalendar
 
    For i = 1 To 37
        f("text" & i) = Null
    Next i
 
    SQL = "SELECT * FROM [qryShifts] WHERE ((MONTH(ShiftDetailDate) = " & f!month & " AND YEAR(ShiftDetailDate) = " & f!year & ")) ORDER BY tblShiftDetail.ShiftDetailDate, tblShiftDetail.ShiftNumber, tblEmployee.EmployeeNumber;"
 
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(SQL)
 
    If rs.RecordCount > 0 Then
        For i = 1 To 37
            If IsDate(f("date" & i)) Then
                MyDate = Format((f("date" & i)), "mm/dd/yyyy")
                rs.FindFirst ("ShiftDetailDate = #" & MyDate & "#")
                    If Not rs.NoMatch Then
                        f("text" & i) = rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & rs!ShiftStartTime & "-" & rs!ShiftEndTime
                    End If
            End If
        Next i
    End If
 
    rs.Close
    Set rs = Nothing
    Set db = Nothing
 
End Sub
 

Thank you
Nick

You can try this logic out, but I can't guarantee anything since it is past my bedtime, and my eyes are getting droopy (LOL). Let me know how you make out:

Public Sub PutInData()
Dim SQL As String
Dim f As Form
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyDate As Date
Dim i As Integer
 
Set f = Forms!frmCalendar
 
For i = 1 To 37
  f("text" & i) = Null
Next i
 
SQL = "SELECT * FROM [qryShifts] WHERE ((MONTH(ShiftDetailDate) = " & f!Month & _
      " AND YEAR(ShiftDetailDate) = " & f!Year & ")) ORDER BY tblShiftDetail.ShiftDetailDate, " & _
      "tblShiftDetail.ShiftNumber, tblEmployee.EmployeeNumber;"
 
Set db = CurrentDb()
Set rs = db.OpenRecordset(SQL)
 
If rs.RecordCount > 0 Then
  For i = 1 To 37
    If IsDate(f("date" & i)) Then
      MyDate = Format((f("date" & i)), "mm/dd/yyyy")
      Do While Not rs.EOF
        If rs![ShiftDetailDate] = "#" & MyDate & "#" Then
          f("text" & i) = rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & _
                          rs!ShiftStartTime & "-" & rs!ShiftEndTime
            Exit Do
        End If
        rs.MoveNext
      Loop
      rs.MoveFirst
    End If
  Next i
End If
 
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub

[nspader]

No Adezzi That didnt work. I am not sure what exactly is going on but clearly it is not recalling multiple files. The logic there seems accurate but do I need to save it in a different place to recall it? I am not sure.

Thanks for the try though...late nights can cause delirium...one should only take in small quantities.

Nick

[ADezii]

No Adezzi That didnt work. I am not sure what exactly is going on but clearly it is not recalling multiple files. The logic there seems accurate but do I need to save it in a different place to recall it? I am not sure.

Thanks for the try though...late nights can cause delirium...one should only take in small quantities.

Nick

Hello Nick, this time let's try Plan B since I'm actually awake now, not that this will make a difference. (LOL).

Public Sub PutInData()
Dim SQL As String
Dim f As Form
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyDate As Date
Dim i As Integer
Dim strShiftDetails As String
 
Set f = Forms!frmCalendar
 
For i = 1 To 37
  f("text" & i) = Null
Next i
 
SQL = "SELECT * FROM [qryShifts] WHERE ((MONTH(ShiftDetailDate) = " & f!Month & _
      " AND YEAR(ShiftDetailDate) = " & f!Year & ")) ORDER BY tblShiftDetail.ShiftDetailDate, " & _
      "tblShiftDetail.ShiftNumber, tblEmployee.EmployeeNumber;"
 
Set db = CurrentDb()
Set rs = db.OpenRecordset(SQL)
 
If rs.RecordCount > 0 Then
  For i = 1 To 37
    If IsDate(f("date" & i)) Then
      MyDate = Format((f("date" & i)), "mm/dd/yyyy")
      Do While Not rs.EOF
        If rs![ShiftDetailDate] = "#" & MyDate & "#" Then
          strShiftDetails = strShiftDetails & rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & _
                            rs!ShiftStartTime & "-" & rs!ShiftEndTime & vbCrLf
        End If
        rs.MoveNext
      Loop
      f("text" & i) = Left$(strShiftDetails, Len(strShiftDetails) - 2)  'Strip vbCrLf
      strShiftDetails = ""      'Reset
      rs.MoveFirst
    End If
  Next i
End If
 
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub

[nspader]

I am sorry to say that didnt work either. I really appreciate your attempts though. I do not fully understand why neither procedure worked. Under my thoughts either should have worked as well. Any other help would be appreciated.

Nick

[nspader]

aDezii

You had the right idea. I have something going on now, where I can see the second file as well. However I do not have the loop working. I am going to work on it a little longer and will post if I need help or when I get it. Thank you for your help so far though.

Nick

[nspader]

Ok, Now the Code below returns 2 files. I have commented out the Loop because when Used it only returns the first record. Presently there are 4 records to return, but depending on Employee Number that will change So I do not want to depend on that.

Can anyone help me figure out this Loop issue?

ADezii, maybe you can take it from here. You helped me get here between the two of us maybe we can figure it out. LOL

Many Thanks
Nick

Public Sub PutInData()
Dim sql As String
Dim f As Form
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyDate As Date
Dim i As Integer
Dim strShiftDetails As String
 
Set f = Forms!frmCalendar
 
    For i = 1 To 37
        f("text" & i) = Null
    Next i
 
    sql = "SELECT * FROM [qryShifts] WHERE ((MONTH(ShiftDetailDate) = " & f!month & " AND YEAR(ShiftDetailDate) = " & f!year & ")) ORDER BY tblShiftDetail.ShiftDetailDate, tblEmployee.EmployeeFirstName;"
 
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(sql)
 
    If rs.RecordCount > 0 Then
        For i = 1 To 37
            If IsDate(f("date" & i)) Then
                MyDate = Format((f("date" & i)), "mm/dd/yyyy")
                rs.FindFirst ("ShiftDetailDate = #" & MyDate & "#")
                    If Not rs.NoMatch Then
                        strShiftDetails = rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & rs!ShiftStartTime & "-" & rs!ShiftEndTime
                        rs.FindNext ("ShiftDetailDate = #" & MyDate & "#")
                           ' Do While rs!ShiftDetailDate = "#' & MyDate $ '#"
                                strShiftDetails = strShiftDetails & vbCrLf & rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & rs!ShiftStartTime & "-" & rs!ShiftEndTime
                            'rs.MoveNext
                            'Loop
                        f("text" & i) = strShiftDetails
                  End If
            strShiftDetails = ""
            End If
        Next i
    End If
 
    rs.Close
    Set rs = Nothing
    Set db = Nothing
 
End Sub
 

[ADezii]

Ok, Now the Code below returns 2 files. I have commented out the Loop because when Used it only returns the first record. Presently there are 4 records to return, but depending on Employee Number that will change So I do not want to depend on that.

Can anyone help me figure out this Loop issue?

ADezii, maybe you can take it from here. You helped me get here between the two of us maybe we can figure it out. LOL

Many Thanks
Nick

Public Sub PutInData()
Dim sql As String
Dim f As Form
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim MyDate As Date
Dim i As Integer
Dim strShiftDetails As String
 
Set f = Forms!frmCalendar
 
    For i = 1 To 37
        f("text" & i) = Null
    Next i
 
    sql = "SELECT * FROM [qryShifts] WHERE ((MONTH(ShiftDetailDate) = " & f!month & " AND YEAR(ShiftDetailDate) = " & f!year & ")) ORDER BY tblShiftDetail.ShiftDetailDate, tblEmployee.EmployeeFirstName;"
 
    Set db = CurrentDb()
    Set rs = db.OpenRecordset(sql)
 
    If rs.RecordCount > 0 Then
        For i = 1 To 37
            If IsDate(f("date" & i)) Then
                MyDate = Format((f("date" & i)), "mm/dd/yyyy")
                rs.FindFirst ("ShiftDetailDate = #" & MyDate & "#")
                    If Not rs.NoMatch Then
                        strShiftDetails = rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & rs!ShiftStartTime & "-" & rs!ShiftEndTime
                        rs.FindNext ("ShiftDetailDate = #" & MyDate & "#")
                           ' Do While rs!ShiftDetailDate = "#' & MyDate $ '#"
                                strShiftDetails = strShiftDetails & vbCrLf & rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & rs!ShiftStartTime & "-" & rs!ShiftEndTime
                            'rs.MoveNext
                            'Loop
                        f("text" & i) = strShiftDetails
                  End If
            strShiftDetails = ""
            End If
        Next i
    End If
 
    rs.Close
    Set rs = Nothing
    Set db = Nothing
 
End Sub
 

The problem would be much easier to diagnose if you E-Mailed me a copy of the Database or a subset of it, is that possible? If so, I can assure you complete privacy.

[nspader]

Absolutely if you want to PM me you email I will send it off.

Thank you

NIck

[ADezii]

Absolutely if you want to PM me you email I will send it off.

Thank you

NIck

Check your Private Messages, you'll have my Address there soon. Please provide all relevant Details as well.

[nspader]

Check your Private Messages, you'll have my Address there soon. Please provide all relevant Details as well.

Azii,

I did figure it out. It is probably a little sloppy but it works. I am working on some other stuf but will post on monday what I have so you can see it.

Thanks

Nick

[ADezii]

Azii,

I did figure it out. It is probably a little sloppy but it works. I am working on some other stuf but will post on monday what I have so you can see it.

Thanks

Nick

I actually have the revised code which I'll post tonight.

[ADezii]

Azii,

I did figure it out. It is probably a little sloppy but it works. I am working on some other stuf but will post on monday what I have so you can see it.

Thanks

Nick

1. Below please find the revised code for the PutInData() Sub-Routine. It has been tested, and is fully operational. You can just replace replace your entire Procedure with this new code, or Copy and Paste over the existing code.
   

   Public Sub PutInData()
   On Error GoTo Err_PutIndata
   Dim sql As String
   Dim f As Form
   Dim db As DAO.Database
   Dim rs As DAO.Recordset
   Dim MyDate As Date
   Dim i As Integer
   Dim strShiftDetails As String
    
   Set f = Forms!frmCalendar
    
   For i = 1 To 37
     f("text" & i) = Null
   Next i
    
   sql = "SELECT * FROM [qryShifts] WHERE ((MONTH(ShiftDetailDate) = " & _
          f!month & " AND YEAR(ShiftDetailDate) = " & f!year & ")) " & _
          "ORDER BY tblShiftDetail.ShiftDetailDate, tblEmployee.EmployeeFirstName;"
    
   Set db = CurrentDb()
   Set rs = db.OpenRecordset(sql)
    
   'Test Loop for Debugging purposes
   'Do While Not rs.EOF
     'Debug.Print rs![ShiftDetailDate] & " ==> " & rs!EmployeeFirstName & " " & _
                 'rs!EmployeeLastName & " " & rs!ShiftStartTime & "-" & rs!ShiftEndTime
     'rs.MoveNext
   'Loop
     'Exit Sub
    
   If rs.RecordCount > 0 Then
     For i = 1 To 37
       If IsDate(f("date" & i)) Then
       MyDate = Format((f("date" & i)), "mm/dd/yyyy")
         Do While Not rs.EOF
           If rs![ShiftDetailDate] = MyDate Then
             strShiftDetails = strShiftDetails & rs!EmployeeFirstName & " " & rs!EmployeeLastName & " " & _
                               rs!ShiftStartTime & "-" & rs!ShiftEndTime & vbCrLf
           End If
           rs.MoveNext
         Loop
         If Len(strShiftDetails) > 0 Then
           f("text" & i) = Left$(strShiftDetails, Len(strShiftDetails) - 2)      'Strip vbCrLf
         End If
         strShiftDetails = ""      'Reset
         rs.MoveFirst
       End If
     Next i
   End If
    
   rs.Close
   Set rs = Nothing
   Set db = Nothing
    
   Exit_PutIndata:
     Exit Sub
    
   Err_PutIndata:
     MsgBox Err.Description, vbExclamation, "Error in PutIndata()"
     Resume Exit_PutIndata
   End Sub

2. Be advised that the PutInData() Routine was being called twice when frmCalendar Opens. In the frmCalendar_Load() Event, the next to the last line calls the Cal([month], [year]) Routine. The last line in this Sub-Procedure calls the PutInData() Routine, then returns code execution back to the frmCalendar_Load() Event. The last line in the Load() Event also calls the Cal(m, y) Routine. Since the call to PutInData() needs to exist independently from the Call in the Load() Event, delete the last line in the frmCalendar_Load() Event, namely, Call Cal([month], [year]). Just download the Attachment to see what I mean.
3. The way frmCalendar is structured, you can not display > 4 Shifts per Day, which is evidenced by only 4 of the 5 Shifts being displayed for April 14, 2008. You need to make provisions for this also.
4. Any other questions, feel free to ask.

[nspader]

That works Perfectlly. Much better then the sloppy version I came up with. The dispplay problem on the calendar is simply text size. Visually you could not see it but it was there.

I have added some more functions to the db and made it more visually pleasing...fixing the problem with not showing more then 4 employees on the calendar. Thank you so much for your help.

Now, I am at the point that I am going to add in time off dates and specific shift dates. I honestly am not sure where to start but I am trying some different things. Any help on this would be appreaciated.

Thank you for everything

Nick

[ADezii]

That works Perfectlly. Much better then the sloppy version I came up with. The dispplay problem on the calendar is simply text size. Visually you could not see it but it was there.

I have added some more functions to the db and made it more visually pleasing...fixing the problem with not showing more then 4 employees on the calendar. Thank you so much for your help.

Now, I am at the point that I am going to add in time off dates and specific shift dates. I honestly am not sure where to start but I am trying some different things. Any help on this would be appreaciated.

Thank you for everything

Nick

You are quite welcome, Nick.