Hi

Any one to help me out on this code?

Private Sub DisplayAppointments()


    Dim RS As Recordset, RS2 As Recordset, RS3 As Recordset, RS4 As Recordset
    Dim X As Long
    Dim S As String
    Dim Fld As Field
    
    
    StatusBox = ""
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE * FROM AppointmentTempT"
    DoCmd.RunSQL "INSERT INTO AppointmentTempT (SaturdayAppointment) VALUES (""Testing"") "
    DoCmd.SetWarnings True
    
    X = 0
    Set RS = CurrentDb.OpenRecordset("SELECT * FROM AppointmentT ORDER BY AppointmentDay ")
    
    While Not RS.EOF
            If DatePart("ww", RS!appointmentday) = DatePart("ww", DisplayDate) And Year(RS!appointmentday) = Year(DisplayDate) Then
                Status RS!Description & " " & "on " & Format(RS!appointmentday, "ddd d-mmm")

                
                Set RS2 = CurrentDb.OpenRecordset("AppointmentTempT")
                
                For Each Fld In RS2.Fields
                    If Fld.Name = "SundayAppointment" Then
                            If Weekday(RS!appointmentday) = 1 Then
                                If RS2!SundayAppointment = "" Then
                                    RS2.AddNew
                                    RS2!SundayAppointment = RS!Description
                                    RS2.Update
                                Else
                                    RS2.Edit
                                    RS2!SundayAppointment = RS!Description
                                    RS2.Update
                                End If
                            End If
                    End If
                    
                    If Fld.Name = "MondayAppointment" Then
                            If Weekday(RS!appointmentday) = 2 Then
                                If RS2!MondayAppointment = "" Then
                                    RS2.AddNew
                                    RS2!MondayAppointment = RS!Description
                                    RS2.Update
                                Else
                                    RS2.Edit
                                    RS2!MondayAppointment = RS!Description
                                    RS2.Update
                                End If
                            End If
                    End If
                    
                    If Fld.Name = "TuesdayAppointment" Then
                            If Weekday(RS!appointmentday) = 3 Then
                                If RS2!TuesdayAppointment = "" Then
                                    RS2.AddNew
                                    RS2!TuesdayAppointment = RS!Description
                                    RS2.Update
                                Else
                                    RS2.Edit
                                    RS2!TuesdayAppointment = RS!Description
                                    RS2.Update
                                End If
                            End If
                    End If
                    
                    
                    
                Next
            X = X + 1
            RS2.Close
            Set RS2 = Nothing
            End If
        RS.MoveNext
    Wend
    
    Status CStr(X) & " Appointments week of " & DisplayDate
            
    RS.Close
    Set RS = Nothing
    
    Me.Requery
    


End Sub