modify code to just insert Mon-Sat date and day for Given Week End

[babs]

Below is code that I have tied to a command button to INSERT the REcord from
the Previous Friday of scheduled work week ( All week based on a Sunday
WeekEnd Date)

I would like to modify the code to add to another button where we JUST want
to Insert the days and workdate for the Given week. When WeekEnd Date will
be on the Form already, For example for WeekEnd date March 28 would want to
insert March 22 Mon, March 23 Tue, March 24 Wed, March 25 Thu, March 25 Fri.

Not sure what I need to delete out and modify below.

Private Sub Command22_Click()
On Error GoTo Err_HandleError

'number of days to add
'change to 5 if you want Mon - Fri
Const intNumDays As Integer = 6

Dim d As DAO.Database
Dim r As DAO.Recordset

Dim dteWeekEndDay As Date ' week ending date
Dim dteFri As Date ' last friday date
Dim dteMon As Date ' next monday date
Dim tmpDate As Date
Dim i As Integer ' loop counter
Dim sSQL As String
Dim WkDay As String

' saves record in main form
If Me.Dirty Then
Me.Dirty = False
End If

Set d = CurrentDb

'- Get the new week ending date (store in a variable)
dteWeekEndDay = Me.txtDate
If Weekday(dteWeekEndDay) <> vbSunday Then
MsgBox "Selected date is not a Sunday. Please check the date and try again."
Exit Sub
End If

'get the previous Sunday date
dteFri = DateAdd("d", -7, dteWeekEndDay)
'- calculate the last Fri date
Do Until Weekday(dteFri) = vbFriday
dteFri = DateAdd("d", -1, dteFri)
Loop

'- calculate the next Monday date (from the last Fri date)
dteMon = DateAdd("d", 3, dteFri)

'- open a recordset based on the Actually sched "JeffTime Card MD
Query-ShedDetails" WHERE [date] =Last Fri
sSQL = "SELECT [Man Name], [Job #], [name],"
sSQL = sSQL & " [Date], Workdate, [actDay],[Hours(ST)]"
sSQL = sSQL & " FROM [JeffTime Card MD Query-ShedDetails]"
sSQL = sSQL & " WHERE [Workdate] = #" & dteFri & "#;"


' Debug.Print sSQL
Set r = d.OpenRecordset(sSQL)
'- check for records in recordset.
' (there should be one Fri record per worker)
' -If no records, exit sub.
If r.BOF And r.EOF Then
MsgBox "ERROR! No records found for the week ending Fri " & dteFri
Else
r.MoveLast
r.MoveFirst

' MsgBox r.RecordCount

'loop thru the recordset
Do While Not r.EOF

tmpDate = dteMon

'- step thru the recordset, inserting 5 or 6 records for eachworker ,
incrementing
'the Workdate for each new record.
For i = 1 To intNumDays '(Monday to Saturday)

Select Case Weekday(tmpDate)
Case 1
WkDay = "Sun"
Case 2
WkDay = "Mon"
Case 3
WkDay = "Tue"
Case 4
WkDay = "Wed"
Case 5
WkDay = "Thu"
Case 6
WkDay = "Fri"
Case 7
WkDay = "Sat"
End Select

'create the insert string
sSQL = "INSERT INTO [JeffTime Card MD Query-ShedDetails]"
sSQL = sSQL & " ([Man Name], [Job #],"
sSQL = sSQL & " [name], [Date],"
sSQL = sSQL & " Workdate,[Hours(ST)])"
sSQL = sSQL & " VALUES (""" & r.Fields(0) & """, " & r.Fields(1)
sSQL = sSQL & ", """ & r.Fields(2) & """, #" & dteWeekEndDay
sSQL = sSQL & "#, #" & tmpDate & "#," & r.Fields(6) & ");"
Me.[EmployeesSubformQuerySUBFORMfor Weekend].Requery

Debug.Print sSQL

'#" & Format(dteWeekday, "m-d-yyyy") & "#," & "#" & Format(Me.Date,
"m-d-yyyy") & "#,""" & Me.cboman.Column(0) & """,""" & Me.cboman.Column(1) &
""")"
'DoCmd.RunSQL (sSQL)



'strSQL = "INSERT INTO [TimeCardMDJEFF] ([workdate],[date],[man
name],[actualRate]) VALUES (#" & Format(dteWeekday, "m-d-yyyy") & "#," & "#"
& Format(Me.Date, "m-d-yyyy") & "#,""" & Me.cboman.Column(0) & """,""" &
Me.cboman.Column(1) & """)"
' Debug.Print sSQL

'increment day
tmpDate = DateAdd("d", 1, tmpDate)

'insert the record
d.Execute sSQL, dbFailOnError

Next i

r.MoveNext
Loop
End If

Exit_HandleError:
On Error Resume Next
'clean up
r.Close
Set r = Nothing
Set d = Nothing
MsgBox "Done"
Exit Sub

Err_HandleError:
Select Case Err.Number
Case 3021
MsgBox "Help"
Case Else
MsgBox Err.Description, vbExclamation, "Search Error " & Err.Number
End Select

Resume Exit_HandleError

End Sub

thanks sooo much,
Barb