PDA

View Full Version : Solved: Vacation Request Sort and View Specific Date



coliervile
02-15-2008, 03:00 PM
On the worksheet "Leave Request" employee's can enter request for time off (vacation or whatever) of work. What I need is a macro that will sort the worksheet using two criterias, the first sort uses the column labeled "Start" and then by the column labeled "Requested".

The second thing I need is a bit more complex I think...I would like a userform that would allow you to see who's on leave on a specified date. For example if an employee wants to know if leave is available on September 5, 2008 they could pull up the userform and enter the date September 5, 2008 and the names of the employee's who have requested this day already would then be displayed in a message box or some other format. In this case using the names currently on the "Leave Request" worksheet the following names would appear 1. GG 2. EE 3. CC 4. BB Is this possible??? A problem I foresee is that the dates that have been requested and aren't listed individually????

Any help would be appreciated .

Best regards,

Charlie

Bob Phillips
02-15-2008, 04:25 PM
Just sort the data with the macro recoder on for the first bit.



Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpEndStart As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim i As Long

With Worksheets("Leave Request")

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpdatesend = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & "<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpdatesend.Address & ">=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")
For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & mpNames.Cells(i, 1) & vbNewLine
End If
Next i

If mpMessage <> "" Then MsgBox mpMessage, vbOKOnly + vbInformation

End With
End Sub

coliervile
02-15-2008, 04:50 PM
XLD that worked fantastic thanks for your help.

coliervile
02-15-2008, 04:52 PM
I'll try the sort on the recorder, but I think I need a worksheet change event to do what I'm thinking. Sort the two columns after new data has been entered???

Best regards,

Charlie

Bob Phillips
02-15-2008, 05:01 PM
I've tagged onto your existing worksheet change code



Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("A:A").Column Then
Cells(.Row, "B").Value = Format(Now, "dd mmm yyyy hh:mm:ss")
End If
End With
Next Cell

If Not Intersect(Target, Me.Range("B:B", "E:E")) Is Nothing Then

Me.Columns("A:E").Sort key1:=Me.Range("D2"), order1:=xlAscending, _
key2:=Me.Range("B2"), order2:=xlAscending, _
header:=xlYes
End If
End Sub

coliervile
02-15-2008, 05:11 PM
Sam Frantastic what a work of art. That was going to be my next quest of how two combine two Worksheet_Change events. I'm going to study your coding so that I can understand how to put these two events together for my edification.

Best regards,

Charlie

coliervile
02-15-2008, 06:00 PM
XLD if I wanted to add a third sort for column "C" and custom that sort to type of leave requested in this order Prime Time, Annual, Credit Used, Sick, LWOP, FEMLA, and FEFLA. Is this possible since Excel normally sorts numerically and alphabetically?

Best regards,

Charllie

Bob Phillips
02-16-2008, 03:11 AM
Excel doesn't do anything ordinarily, it does everything extra-ordinarily, which is why it is so over-used.

It can be done with customs lists, but if it is a 3rd sort key, I fail to see how it will work as the second key, the Requested date/time will be so unique that the 3rd key will never kick in.

Anyway, this does it. I tested it by changing the start date and the requested date/time to force the issue (I had to remove the DV on Requested as it only allowed dates in 2006!).

coliervile
02-16-2008, 03:43 AM
"xld" I see your point on this and I won't use this 3rd sort it really defeats the purpose. One last thing and I'll mark this solved...on the message box is it possible to display both the "Name" and "Type" of leave?

Thanks for your help and time.

Best regards,

Charlie

Bob Phillips
02-16-2008, 04:06 AM
Maybe you should drop the requested part of the sort, it does eem a tad irrelevant as to when they request leave.



Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpEndStart As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim i As Long

With Worksheets("Leave Request")

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpdatesend = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & "<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpdatesend.Address & ">=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")
For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & mpNames.Cells(i, 1) & " - " & mpNames.Cells(i, 3) & vbNewLine
End If
Next i

If mpMessage <> "" Then MsgBox mpMessage, vbOKOnly + vbInformation

End With
End Sub

coliervile
02-16-2008, 04:20 AM
"xld" I came across a problem when executing the Date Search. I added to row 10 the name "FF" and a request for 6-Sep-08 through 9-Sep-08. When I search for the date of 8-Sep-08 the following order of request come up... BB, FF and AA. By the "Requested", column "B", date and time the correct order should be BB, AA and FF. This is one of the problems I foresaw of how to separate the dates requested by the Requested date and time because the dates are all grouped together. Is there a way to accomplish this issue when using the Date Search?

Best regards,

Charlie

coliervile
02-16-2008, 04:22 AM
Oooops! Here's the file.

Best regards,

Charlie

Bob Phillips
02-16-2008, 04:38 AM
The file you posted has far more entries that match, 6 to be precise. Further to that, I do not see the problem, you see the same order as the list is in, what is wrong with that?

coliervile
02-16-2008, 04:52 AM
The reasoning behind my thoughts are when an employee or supervisor searched a specific date they can see what employee had requested the time off of work first in order. I could use this, complements of you, adding thie Request date and time to the message box.

Best regards,

Charlie

Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpEndStart As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim i As Long

With Worksheets("Leave Request")

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpdatesend = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & "<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpdatesend.Address & ">=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")
For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & mpNames.Cells(i, 1) & " - " & mpNames.Cells(i, 3) & vbNewLine & " - " & mpNames.Cells(i, 2) & vbNewLine
End If
Next i

If mpMessage <> "" Then MsgBox mpMessage, vbOKOnly + vbInformation

End With
End Sub

Bob Phillips
02-16-2008, 05:10 AM
I thought that you wer worried about the order of output. YOu could always sort it before the serach, the re-sort afterwards?



Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpEndStart As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim i As Long

With Worksheets("Leave Request")

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpdatesend = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

mpRows = .Evaluate("IF((" & mpDatesStart.Address & "<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpdatesend.Address & ">=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")
For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine
End If
Next i

If mpMessage <> "" Then MsgBox mpMessage, vbOKOnly + vbInformation

End With
End Sub

coliervile
02-16-2008, 05:11 AM
Can a sort be added to the "message box"???

Best regards,

Charlie

Bob Phillips
02-16-2008, 05:16 AM
Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpEndStart As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim i As Long

On Error GoTo ta_exit
Application.ScreenUpdating = False

With Worksheets("Leave Request")

mpTestDate = CDate(Me.TextBox1.Text)
mpLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set mpDatesStart = .Range("D1").Resize(mpLastRow)
Set mpdatesend = .Range("E1").Resize(mpLastRow)
Set mpNames = .Range("A1").Resize(mpLastRow)

.Columns("A:E").Sort key1:=.Range("B2"), order1:=xlAscending, _
key2:=.Range("D2"), order2:=xlAscending, _
header:=xlYes

mpRows = .Evaluate("IF((" & mpDatesStart.Address & "<=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)*" & _
"(" & mpdatesend.Address & ">=--""" & Format(mpTestDate, "yyyy-mm-dd") & """)," & _
"ROW(" & mpNames.Address & "))")

For i = LBound(mpRows) To UBound(mpRows)

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine
End If
Next i

If mpMessage <> "" Then MsgBox mpMessage, vbOKOnly + vbInformation

.Columns("A:E").Sort key1:=.Range("D2"), order1:=xlAscending, _
key2:=.Range("B2"), order2:=xlAscending, _
header:=xlYes

End With

ta_exit:
Application.ScreenUpdating = True
End Sub

coliervile
02-16-2008, 05:28 AM
"xld" you're an absolute WIZARD with macros :bow: :beerchug: :friends: ...it's absolutely "perfecto". I'll mark this Thread solved. Have a great day and thanks for all of your hard work and time.

Best regards,

Charlie