Scanning schedule

[shekhar_pc]

try.xls
	A	B	C	D	E	F	G	H	I	J
1	Employee	Emp ID	2-Dec	3-Dec	4-Dec	5-Dec	6-Dec	7-Dec	8-Dec	9-Dec
2	A	1234	09:00 PM - 06:00 AM	09:00 PM - 06:00 AM	09:00 PM - 06:00 AM			09:00 PM - 06:00 AM	09:00 PM - 06:00 AM
3	B	1235	11:30 PM - 08:30 AM	11:30 PM - 08:30 AM			11:30 PM - 08:30 AM	11:30 PM - 08:30 AM	11:30 PM - 08:30 AM
4	C	1236		02:30 AM - 11:30 AM	Casual Leave	02:30 AM - 11:30 AM	02:30 AM - 11:30 AM	02:30 AM - 11:30 AM
5	D	1237			05:30 AM - 03:00 PM	05:30 AM - 03:00 PM	05:30 AM - 03:00 PM	05:30 AM - 03:00 PM	05:30 AM - 03:00 PM
6	E	1238	11:30 PM - 08:30 AM			11:30 PM - 08:30 AM	11:30 PM - 08:30 AM	11:30 PM - 08:30 AM	11:30 PM - 08:30 AM
7	F	1239				05:30 AM - 03:00 PM	Sick Leave	05:30 AM - 03:00 PM	05:30 AM - 03:00 PM	05:30 AM - 03:00 PM
8	G	1240	09:00 PM - 06:00 AM	09:00 PM - 06:00 AM	09:00 PM - 06:00 AM	09:00 PM - 06:00 AM	09:00 PM - 06:00 AM
9	H	1241				02:30 AM - 11:30 AM	02:30 AM - 11:30 AM	02:30 AM - 11:30 AM	02:30 AM - 11:30 AM	02:30 AM - 11:30 AM
Sheet1

Hi!

I have posted this question earlier but did not get any help. I have tried a lot but I am unable to achieve what I need.

The table posted above is the schedule for my employee. I need an input box which asks for a date. When the user supplies date, it should look for people who are scheduled for that particular date and who are on leave and put the result in the next worksheet at the last occupied row.

For instance, if I supply the date as 2nd Dec then the next worksheet should be filled with @ row # 2 (Row1 has headings)
Employee Emp ID Schedule
A 1234 09:00 PM - 06:00 AM
B 1235 11:30 PM - 08:30 AM
C 1236 02:30 AM - 11:30 AM
E 1238 11:30 PM - 08:30 AM
G 1240 09:00 PM - 06:00 AM

Then if I select 3rd Dec, the next worksheet should be filled with the following data starting fom row number 7 (just below the above data)
A 1234 09:00 PM - 06:00 AM
B 1235 11:30 PM - 08:30 AM
D 1237 05:30 AM - 03:00 PM
G 1240 09:00 PM - 06:00 AM

 

[shekhar_pc]

Still not working the way I want. Lets say if I change the schedule for 7-Dec to the below and keep 8th Dec schedule as it is as per my first post.

Employee Emp ID 7-Dec
A 1234 09:00 PM - 06:00 AM
B 1235 Sick Leave
C 1236 02:30 AM - 11:30 AM
D 1237 05:30 AM - 03:00 PM
E 1238 11:30 PM - 08:30 AM
F 1239 05:30 AM - 03:00 PM
G 1240
H 1241 02:30 AM - 11:30 AM

The extracted schedule should be:

A 1234 09:00 PM - 06:00 AM
B 1235 Sick Leave
D 1237 Casual Leave
E 1238 11:30 PM - 08:30 AM
F 1239 05:30 AM - 03:00 PM
H 1241 02:30 AM - 11:30 AM

whereas after editing the line and running your code, I am not getting schedule for "F" and "H"???

"F" is working in 5:30 AM shift on 8th so ideally it is a shift for 7th and should be extracted.
similarly, "H" is working in 2:30 AM shift on 8th so ideally it is a shift for 7th and should be extracted.

 

[Krishnakumar]

OK. See if this helps you.

Sub SchedScan_v02()
Dim ws1     As Worksheet, ws2   As Worksheet
Dim lRow    As Long, DtCol      As Byte
Dim SchdDt  As String, SchCell  As Range
Dim Rng     As Range, SchdTime  As String
Dim Dest    As Range, x

Set ws1 = Sheets("Sheet1"): Set ws2 = Sheets("Sheet2")
lRow = ws1.Range("A" & Rows.Count).End(xlUp).Row
Set Dest = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1)
SchdDt = Application.InputBox("Enter Date", "Schedule Date", "m/d/yyyy")
    Application.ScreenUpdating = False
    If SchdDt = vbNullString Then
        Exit Sub
    End If
    SchdDt = Format(SchdDt, "d-mmm")
    If Application.WorksheetFunction.CountIf(ws1.Rows(1), SchdDt) > 0 Then
    DtCol = ws1.Rows(1).Find(What:=SchdDt, LookIn:=xlValues).Column
        Set Rng = ws1.Range(ws1.Cells(2, DtCol), ws1.Cells(lRow, DtCol))
            For Each SchCell In Rng
                If Not IsEmpty(SchCell) Then
                    x = Split(SchCell.Value, "-")
                    SchdTime = x(0)
                    If InStr(1, SchdTime, "PM") > 0 Or _
                            InStr(1, SchCell.Value, "Leave") > 0 Then
                        Dest = ws1.Cells(SchCell.Row, 1)
                        Dest.Offset(, 1) = ws1.Cells(SchCell.Row, 2)
                        Dest.Offset(, 2) = SchCell
                        Set Dest = Dest.Offset(1)
                    Else
                        If InStr(1, SchdTime, "AM") > 0 Then
                            If Not IsEmpty(SchCell.Offset(, 1)) Then
                                x = Split(SchCell.Offset(, 1).Value, "-")
                                SchdTime = x(0)
                                If InStr(1, SchCell.Offset(, 1), "Leave") > 0 Or _
                                    InStr(1, SchdTime, "AM") > 0 Then
                                    Dest = ws1.Cells(SchCell.Row, 1)
                                    Dest.Offset(, 1) = ws1.Cells(SchCell.Row, 2)
                                    Dest.Offset(, 2) = SchCell.Offset(, 1)
                                    Set Dest = Dest.Offset(1)
                                End If
                            End If
                        End If
                    End If
                Else
                    If Not IsEmpty(SchCell.Offset(, 1)) Then
                        x = Split(SchCell.Offset(, 1).Value, "-")
                        SchdTime = x(0)
                            If InStr(1, SchdTime, "AM") > 0 Then
                                Dest = ws1.Cells(SchCell.Row, 1)
                                Dest.Offset(, 1) = ws1.Cells(SchCell.Row, 2)
                                Dest.Offset(, 2) = SchCell.Offset(, 1)
                                Set Dest = Dest.Offset(1)
                            Else
                                GoTo Again
                            End If
                    Else
                        GoTo Again
                    End If
                End If
Again:
            Next SchCell
    Else
        MsgBox "Date: '" & SchdDt & "' Not Found!"
    End If
    Application.ScreenUpdating = True
End Sub

 

[shekhar_pc]

Yet it did.

Ultimate solution. Greatly appreciated...... Thank you very much for looking into my problem. I have been running around with this for quite some days. Inspite of my unclear explanation, you've understood the entire scenario. Thanks again.

Cheers !

 

[Krishnakumar]

Yet it did.

Ultimate solution. Greatly appreciated...... Thank you very much for looking into my problem. I have been running around with this for quite some days. Inspite of my unclear explanation, you've understood the entire scenario. Thanks again.

Cheers !

You are welcome