Solved: Search- 2 Sets of Dates Between 2 Other Sets Of Dates

[coliervile]

In the following workbook I have a userform that search's for a specific date (e.g. March 7, 2008) on a worksheet "Leave Request" in Column "D"- "Start" and column "E"- "End". What I would like to do now is do the same type of search, but use a start date and a end date (e.g. March 1, 2008 to March 31, 2008) to search the same columns on the worksheet "Leave Request" and then if any of the dates match sort the dates by column "D" and then by column "B". Then write the the row information (columns "A" through "E") to the Printout worksheet...very similar to this coding used for the single date search below...

I think there has to be at least two (2) Evaluations involved and that's well above my limited pool of VBA knowledge level...:bow: Any passwords needed are "password" .

[VBA][Private Sub TextBox1_AfterUpdate()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpDatesEnd As Range
Dim mpTestDate As Date
Dim mpMessage As String
Dim LastRowPrintout As Long
Dim i As Long

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("B2"), Order1:=xlAscending, _
Key2:=.Range("D2"), Order2:=xlAscending, _
Header:=xlYes

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 & _
"<=" & CLng(mpTestDate) & ")*" & _
"(" & mpDatesEnd.Address & ">=" & _
CLng(mpTestDate) & ")," & _
"ROW(" & mpNames.Address & "))")

If Not IsArrayAllocated(mpRows) Then

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
Else

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

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & "Requested" & " " & mpTestDate & " " & _
"Off- " & " " & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", Requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine

LastRowPrintout = Worksheets("Printout").Range("A" & Rows.Count).End(xlUp).Row
.Rows(i).Copy Worksheets("Printout").Range("A" & LastRowPrintout + 1)
End If
Next i

If mpMessage <> "" Then

MsgBox mpMessage, vbOKOnly + vbInformation
Else

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
End If
End If

.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes

Sheets("Leave Request").Visible = False
End With
End Sub/VBA]

[Bob Phillips]

Thr project is password protected.

[Bob Phillips]

Just seen that you gave the password in the first post.

I can't even fire the button code at the moment, but what exactly do you want. If the start date is before the specified start dat but the end date is before the specified end dat, do you wat to include it or must both date be within the specified dates?

[coliervile]

I'm guessing that the array formula would resemble something like this:

=IF(OR(mpTestDate1>=mpDatesStart,mpTestDate1<=mpDatesStart),(OR(mpTestDate2>=mpDatesEnd,mpTestDate2<=mpDatesEnd)))

mpTestDate1 equals the Start Date from the "frmBtwnDates" userform
mpTestDate2 equals the End Date from the "frmBtwnDates" userform
mpDatesStart equals "Start" column "D1" from "Leave Request" worksheet
mpDatesEnd equals "End" column "E1" from "Leave Request" worksheet

if either TestDates 1 or 2 were True then copy the rows (mpNames column "A1" from "Leave Request" worksheet) to "Printout" worksheet to the last empty row.

[Bob Phillips]

It depends upon the answer to my question.

[coliervile]

"XLD" good morning or afternoon how's your day going??? What I want to do is pull up anyone that has requested time off of work between two date (e.g. March 1, 2008 and March 31, 2008) or whatever date is put in the userform and copy the rows over to "Printout" worksheet.

[Bob Phillips]

Morning,

I think this does what you want



Option Explicit

Private Sub CommandButton1_Click()
Dim mpLastRow As Long
Dim mpRows As Variant
Dim mpNames As Range
Dim mpDatesStart As Range
Dim mpDatesEnd As Range
Dim mpTestDate1 As Date
Dim mpTestDate2 As Date
Dim mpMessage As String
Dim LastRowPrintout As Long
Dim i As Long

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("B2"), Order1:=xlAscending, _
Key2:=.Range("D2"), Order2:=xlAscending, _
Header:=xlYes

mpTestDate1 = CDate(Me.txtSDate.Text)
mpTestDate2 = CDate(Me.txtEDate.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 & _
"<=" & CLng(mpTestDate1) & ")*" & _
"(" & mpDatesEnd.Address & ">=" & _
CLng(mpTestDate2) & ")," & _
"ROW(" & mpNames.Address & "))")

If Not IsArrayAllocated(mpRows) Then

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
Else

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

If mpRows(i, 1) <> False Then

mpMessage = mpMessage & "Requested" & " " & mpTestDate1 & " " & _
"Off- " & " " & mpNames.Cells(i, 1).Value & _
" (Leave type: " & mpNames.Cells(i, 3).Value & _
", Requested on: " & mpNames.Cells(i, 2).Text & ")" & vbNewLine & vbNewLine

LastRowPrintout = Worksheets("Printout").Range("A" & Rows.Count).End(xlUp).Row
.Rows(i).Copy Worksheets("Printout").Range("A" & LastRowPrintout + 1)
End If
Next i

If mpMessage <> "" Then

MsgBox mpMessage, vbOKOnly + vbInformation
Else

MsgBox "No Leave Request For This Date", vbOKOnly + vbInformation
End If
End If

.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes

Sheets("Leave Request").Visible = False
End With
End Sub


Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub txtSDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Load frmCalendar
frmCalendar.ocxCalendar.Value = Now()
If Not frmCalendar.UserCancelled Then
If IsDate(frmCalendar.ocxCalendar.Value) Then
txtSDate.Text = Format(frmCalendar.ocxCalendar.Value, "mmm-dd-yyyy")
End If
End If
Unload frmCalendar
txtSDate.SelStart = 1
txtSDate.SelLength = Len(txtSDate.Text)

End Sub

Private Sub txtEDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Load frmCalendar
frmCalendar.ocxCalendar.Value = Now()
If Not frmCalendar.UserCancelled Then
If IsDate(frmCalendar.ocxCalendar.Value) Then
txtEDate.Text = Format(frmCalendar.ocxCalendar.Value, "mmm-dd-yyyy")
End If
End If
Unload frmCalendar
txtEDate.SelStart = 1
txtEDate.SelLength = Len(txtEDate.Text)

End Sub
Function IsArrayAllocated(Arr As Variant) As Boolean
On Error Resume Next
IsArrayAllocated = Not (IsError(LBound(Arr))) And _
IsArray(Arr) And _
(LBound(Arr) <= UBound(Arr))
End Function

[Bob Phillips]

No that's not right, try this change



mpRows = .Evaluate("IF((" & _
"(" & mpDatesStart.Address & ">=" & CLng(mpTestDate1) & ")*" & _
"(" & mpDatesStart.Address & "<=" & CLng(mpTestDate2) & "))+(" & _
"(" & mpDatesEnd.Address & "<=" & CLng(mpTestDate1) & ")*" & _
"(" & mpDatesEnd.Address & ">=" & CLng(mpTestDate2) & "))," & _
"ROW(" & mpNames.Address & "))")

[coliervile]

"XLD" I ran the code and the message box popped up and said "No Leave Request for this Date. The dates I used were March 1, 2008 and March 31, 2008 and should have displayed the only two entries on "Leave Request". I also took a look on the "Printout" worksheet and nothing was on there. Here's the woorkbook...

[coliervile]

OOOOPS!!!

[Bob Phillips]

Have you seen my correction?

[coliervile]

"XLD" we over posted each other and your last posting worked and did the trick. Thanks a million!

Is the color scheme less BARF LIKE?

[coliervile]

Well I thought that had done the trick, but I did a search of March 5, 2008 though March 28, 2008 and it only displayed "EE" that had March 27, 2008 to March 29, 2008 and didn't display "BB" that had March 3, 2008 to March 7, 2008. Here's a copy of the workbook....

[Bob Phillips]

I have to leave for the moment, I will be back onto it in a couple of hours.

[coliervile]

Thanks have a good time.

[coliervile]

I'm not sure if this helps, but I see that there are 5 types of evaluation or comparisions that the array formula needs to do. I've attached a workboork that shows my thoughts. Hopefully this helps in finding an answer??? :doh:

[Bob Phillips]

OK try again



mpRows = .Evaluate("IF(" & _
"(" & mpDatesEnd.Address & ">=" & CLng(mpTestDate1) & ")*" & _
"(" & mpDatesStart.Address & "<=" & CLng(mpTestDate2) & ")," & _
"ROW(" & mpNames.Address & "))")

[coliervile]

Once again we over posted each other simultaneously. You coding covers every instance that I mentioned in my "Evaluation Types"...you're a GENIUS Bob!!! :bow: :clap: I play around with it some more just to be certain everything is covered.

[Bob Phillips]

I tried as many as I could think of, but real users do the best testing.

[coliervile]

I've tried as many variables as posible and it seems to have done the trick. This has been a fun project and a great learning experience.

"XLD" did you get a chance to look through the whole workbook??? I've added various security/protection to the workbook, worksheets, command buttons, and VBA. I know that Excel doesn't provide the highest of security/protection, but these I've added are pretty good I think???

[Bob Phillips]

I'll take a nother look, but a couple of prelimnary comments.

The layout of the form is better, but you will never convince me on the colours I am afraid. Personally, I would not have all of the change options on this form, I would just throw up the list and have edit, update, delete etc. buttons on that., and then trow up a sub-form for each option.

You should also pay some attention to the tab order, the controls tab order should reflect the form navigation sequence. The search form ceratinly fails on that count.

[coliervile]

Thanks for you comments. Sorry that the colours scare you. What particular Options would you allow the user? I was thinking Search by Date, Search by Name, View Print, Clear Form.

I don't want the employee to having access to the following:

1) Edit Selection
2) Delete Selection

A separate userform fro Administrative actions could be made to put:

1) Edit Selection
2) Delete Selection
3) Search Between Dates
4) Close and Save
5) Close and Do Not Save
6) Clear Print Area

You're comments would be very much appreciated.

[Bob Phillips]

It is not which options that I would allow the user, that is up to you, but wat I am saying is that I would use the initial form for just one thing, that is the sub-option selection. SO as you do wiith Search by Date, I would have the data entry options be chosen from the main form, and another form for the actual work. In other words, don't use a form for two things, keep it simple.

[coliervile]

"XLD" I made a few adjustments and incorporated an Employee Option and a Administrative command button. I kept the Employee Option's on the incorporated too. I understand your thoughts about keeping it simple and a userfom performing one function but being such a small workbook I couldn't see why make the user click out of one userform and go to another. I actually should remove the Employee Option form and command button and leave it all on the frmRequest. Your thoughts and anyone else's thoughts are appreciated.

If someone wanted to return to the defult colors and fonts in the workbook is there an easy way???

[Bob Phillips]

I think it is all a question of psychology Charlie. By presenting less detail on a screen/form, you make it easier for the user to make a correct decision. So breaking it down means that they assimilate each screen/form more easily, take the appropriate action more quickly, and feel more comfortable with the application. By being more comfortable, they like it more, thus thus they are likely too use it better and pay more attention to getting the data correct (which is the bane of all applications). I think that you would find that most people don't mind multiple screens/forms, especially if each is well-laid out, intuitive and logical. And the break between one screen/form and the next actually detracts from any slowness that there might be, the user feels more involved (they clicked the button that said get that screen/form and all of its data), and doesn't feel that they are siiting waiting for the app.

As for the colours, if I understand you correctly, not that I know of, but you could give them a button to revert to no colour, and see how many use it.

[coliervile]

Here's the workbook with the normal coloring put back into it and I removed the Employee Options from the frmRequest. Tell me what you think compared to the colored version???

I thought we would have more people commenting on this that just us two. Hopefully we'll have more making comments.

[Bob Phillips]

Here's the workbook with the normal coloring put back into it and I removed the Employee Options from the frmRequest. Tell me what you think compared to the colored version???

Workbook not attached.


I thought we would have more people commenting on this that just us two. Hopefully we'll have more making comments.

Start a new thread specifically seeking out comments. Write a good synopsis of the matter under discussion, and invite thoughts. Maybe tie it to a poll, with a few options.

[coliervile]

Thanks "XLD". I think that's a good idea:

Start a new thread specifically seeking out comments. Write a good synopsis of the matter under discussion, and invite thoughts. Maybe tie it to a poll, with a few options.

It's always great to network with otfhers for ideas to make a better product.