Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Display DateSerial value in text box on form 4

Status
Not open for further replies.

THWatson

Technical User
Apr 25, 2000
2,601
CA
The form is called (currently in design stage) Form3.

1. There is a text box called "txtYear" in which the user enters a 4 digit year.

2. There is a list box called "lstMonths" based on a table. It simply lists the month names January through December.

3. There is a text box called "txtMonth" which will display the month selected in lstMonths.

4. There is a list box called "lstMonthYear" the row source for which is a Select Query which is fed from a table called "tblMonths."
There are actually only 2 fields in the table, MonthYear and Required.
The SQL for the query however extracts the Year, the Month, and uses a DateSerial function to get the first and last days of the month. The SQL is
Code:
SELECT tblMonths.MonthYear, Right([MonthYear],4) AS [Year], Format([MonthYear],"mmmm") AS [Month], DateSerial(Year([MonthYear]),Month([MonthYear]),1) AS FirstOfMonth, DateSerial(Year([MonthYear]),Month([MonthYear])+1,0) AS LastOfMonth
FROM tblMonths
ORDER BY tblMonths.MonthYear;

What ends up getting displayed in lstMonthYear is the MonthYear column, column 0, from the table. The user selects nothing here. The value gets fed from a command button which has the following code
Code:
Dim sql As String
Dim strWHERE As String
strWHERE = "WHERE (Right([MonthYear], 4) = [txtYear]) And (Format([MonthYear], 'mmmm') = [txtMonth]) "
sql = "SELECT tblMonths.MonthYear, Right([MonthYear],4) AS [Year], Format([MonthYear],'mmmm') AS [Month] " _
& "FROM tblMonths " _
& strWHERE & "ORDER BY tblMonths.MonthYear;"
Me.lstMonthYear.RowSource = sql

I have put on the form 2 additional text boxes, "txtStartDate" and "txtEndDate."
In txtStartDate I want to display the first day of the month selected in the process (e.g. March 1, 2009).
In txtEndDate I want to display the last day of the month selected (e.g. March 31, 2009).

I have tried putting the DateSerial serial function as the control source for the respective txtStartDate and txtEndDate text boxes. I have tried adding code to the command button to populate those text boxes. I have also tried putting code on the AfterUpdate event for lstMonthYear but since it itself is populated by code this doesn't work.

The actual end purpose for this form is to display those members who achieved Perfect Attendance in a club for a given month.

Any ideas would be appreciated.

Tom
 
Why not bypass the pop-up form...leave the Month and Year selector combo boxes on frmPerfectAttendance, remove the OK and Cancel buttons and the hidden text boxes, then set the control source for txtStartDate to
Code:
=DateSerial([cmboYear],[cmbomonth],1)
and the control source for txtEndDate to
Code:
=DateSerial([cmboYear],[cmbomonth]+1,0)

Add this code to the cmdFindPerfect_Click() button
Code:
If Not IsDate(Me.txtEndDate) Or Not IsDate(Me.txtStartDate) Then
    MsgBox "Must provide start and end dates"
    Exit Sub
  ElseIf Me.txtStartDate > DateSerial(Year(Date), Month(Date) + 1, 0) Or Me.txtEndDate > DateSerial(Year(Date), Month(Date) + 1, 0) Then
    MsgBox "Can not have the Start or End Date in the future"
    Exit Sub
  ElseIf Me.txtStartDate > Me.txtEndDate Then
    MsgBox "Start Must be before End date"
    Exit Sub
  Else
    GoTo ProcessContinue
  End If
ProcessContinue:

Me!fsubPerfectStreak.Form.RecordSource = "qryRangePerfect"
Me.fsubPerfectStreak.Form.Requery

If IsNull(Me!fsubPerfectStreak.Form!FullName) Then
Call MsgBox("There is no data for the dates selected.", vbExclamation, "No data")
End If

Thoughts?

Tom
 
Yes you could keep them on the form it simplifies things. The pop up would save some real estate. On that note, what resolution are you designing? In order for me to see that form I have to go to a very high resolution 1280 X 1024 and there are no scroll bars. Most of the Kiwanis will not be young guys with 20x20 vis, so I imagine they will not be running that high of resolution. I try to design at 1024 x 768. It seems to be the most used. There is code out there for dynamically resizing based on resolution, but everything I found works "so-so". Most work better at stretching than shrinking.
 
Yes, you are right. I am running out of real estate. However I am thinking about taking the subforms off the frmPerfectAttendance as they only provide a visual without the necessity of running a report...but one could argue that doing a report in Preview is every bit as good as having it in a subform, especially when you have to scroll to see stuff.
I have left it as is for now, until I get all of the reports built that I want. I have 3 done, but still want about 3 more, so Larry has choices.
You have any thoughts about this?

I have a 22 inch monitor, so the resolution is 1680 x 1050.

Larry, my Kiwanian friend who will be running it, has a 19" monitor, I think. But he hasn't complained.

Larry has run into a very strange problem. There is a form in which he can select names and print #10 envelopes, but the envelope report persists in showing up in Letter mode. There are some reports that persist in showing up in #10 envelope mode rather than Letter mode.
What makes this weird is that I have a code module which sets those reports to the proper printer setting upon startup of the database. So I never run into a problem.
What makes it doubly weird is that he put the program on his 3 year old laptop and even when hooked up to the same printer it runs without any problem whatsoever.

The error that he gets when he attempts to change the Page Setup in a report is "out of memory." But his computer is only a year old and he has 2 meg of RAM.

This is Larry's e-mail message to me. It's a Canon printer, 2 years old. "Everything goes well until I attempt to save the printer settings. An error box flashes up and then disappears again, covered by another saying "There is not enough memory. Close unneeded programs". Bunk I say. Nothing but the database is running, and Task manager says I'm using about 650 mb of 2 Gigs of RAM. I have rebooted and tried again, with the same result. Microsoft's error reporting routine tells me I should upgrade from Access 2000.

I have had him reinstall the printer driver, defrag, uninstall, use Windows Install Clean-up to make sure things are gone, also then put a small file on so there is no imprinting on the same sectors when he reinstalls Office. But none of this has made any difference.

Tom
 
You may want to start that as a new thread in the reports forum to get more suggestions. Once you get a thread this long few people will start participating.
 
Good idea. I see we passed the magic 100 mark!

Tom
 
Here's a further code formulation I made
Code:
Private Sub cmdFindPerfect_Click()
Dim sql As String
Me.lstMembers = Null

Dim DteTmp As Variant
Dim DteTmp2 As Variant
DteTmp = DMin("[MeetingDate]", "tblAttendance")
DteTmp2 = DMax("MeetingDate", "tblAttendance")


If Not IsDate(Me.txtEndDate) Or Not IsDate(Me.txtStartDate) Then
    MsgBox "Must provide start and end dates"
    Exit Sub
  ElseIf Me.txtStartDate > DateSerial(Year(Date), Month(Date) + 1, 0) Or Me.txtEndDate > DateSerial(Year(Date), Month(Date) + 1, 0) Then
    MsgBox "Can not have the Start or End Date in the future"
    Exit Sub
  ElseIf Me.txtStartDate > Me.txtEndDate Then
    MsgBox "Start Must be before End date"
    Exit Sub
  ElseIf Me!txtStartDate < DateSerial(Year(DteTmp), Month(DteTmp), 1) Then
    MsgBox "We do not have data prior to " & Format(DMin("[MeetingDate]", "tblAttendance"), "mmmm yyyy")
    Exit Sub
  ElseIf Me!txtEndDate > DateSerial(Year(DteTmp2), Month(DteTmp2), Day(DteTmp2)) Then
    MsgBox "We do not have data after " & Format(DteTmp2, "mmmm dd, yyyy")
    Exit Sub
  Else
    GoTo ProcessContinue
  End If
ProcessContinue:

Me!fsubPerfectStreak.Form.RecordSource = "qryRangePerfect"
Me.fsubPerfectStreak.Form.Requery

If IsNull(Me!fsubPerfectStreak.Form!FullName) Then
Call MsgBox("There is no data for the dates selected.", vbExclamation, "No data")
End If

End Sub

Tom
 
MajP
I hope you get this message.

An interesting thing is happening. The data in the database starts October 2005 and continues on through July 2009, with data being added each week as attendance for members occurs.

When I run the form to produce Perfect Attendance, everything works properly from October 2007 on, but errors out with data prior to then, with Error 84 (invalid use of Null) and the only way to get out is to shut down the database.

The fault lies somewhere in the module functions, and it seems to me it has to do with the DLookup function, or maybe the 2 DCount functions, or maybe the way the start and end dates get determined.

I tried changing the DCount functions to use the form's Start and End dates from the user input text boxes, but this results in everyone in the database having 1 Perfect Attendance Month.

I can get some correct results by changing the DLookup line to
Code:
getNumberMeetings = Nz(DLookup("Required", "tblMonths", "MonthYear = " & getSQLDate(dtmDate)), 4)
It's not clear to me, however, why that fixes it. Because there is no missing data associated with that line.

Secondly, an example, member Ferraro only joined the club in February of 2009. Why would she show up with 1 Perfect Attendance month no matter where in the database you check for Perfect Attendance? When I plug in, for example, January 2006 she's there.

Tom
 
Any chance you deleted dates out of "tblMonths"? What is your first date in "tblMonths"?

You probably want to put some error checking routines in the functions, and do some null checking. Post the most recent version of the database. You can delete information out of the members table except member ID and last name.

The second problem is probably a logic error on my part.
 
MajP
I originally had dates in there from October 2000 onward. But since we only have data from October 2005 on, I removed any prior to that. So the first date in tblMonths is October 2005.

I have put error checking in. The place where it seems to fault out on is the DLookup function, unless I change it to what I posted above.

I'll try to post the db on 4Shared.com. I tried last night but for the summer I am compelled to use slow dial-up and it wouldn't take. I'll try again.

Here they are


Tom
 
MajP
It seems that if I go into tblMonths and add September 2005 then the module works properly, without encountering Error 94.

I can also remove the Nz function from the DLookup line in the module and leave it as
Code:
getNumberMeetings = DLookup("Required", "tblMonths", "MonthYear = " & getSQLDate(dtmDate))

I'm not clear why we need to add September 2005 to make things work, since we only have actual meetings data to October 2005, however...

I still don't understand why member Ferraro will show up in results earlier than February 2009 - her date of joining the club. How could she have one month's Perfect Attendance at any point prior to February 2009?

Tom
 
MajP
One other thing...the Perfect Attendance pieces in the Perfect Attendance form that use the module - "Preview # of Consecutive Perfect months in Range..." and "Preview Members with 12 or more consecutive perfect months in range..." run a fair bit more slowly than before, now that the DCount lines in the module run from a Union query.

Not sure why.

Tom
 
MajP
I apologize. I posted those files in a rush because we have had to go to another city because my wife's brother died. And I realize that I neglected to post the Archive file.

So here are the 3 necessary files - Front End, Back End and Archive.


Again, my apologies.

Tom
 
MajP
There's a line in the piece of the code - the red line...
Code:
Do Until Not (perfectMonth)
  perfectMonth = False
  numMeetings = getNumberMeetings(currentMonth)
  numAttended = getNumberMeetingsAttended(memID, currentMonth)
  numMakeUps = getNumberMakeUps(memID, currentMonth)
  [COLOR=red]If numMakeUps > 5 Then
    numMakeUps = 4[/color]
  End If
  If numMakeUps + numAttended >= numMeetings Then
    perfectMonth = True
    getStreakStart = currentMonth
    currentMonth = DateSerial(Year(currentMonth), Month(currentMonth) - 1, 1)
  End If
 Loop

According to the rules, the maximum # of Makeups allowed is 4. So I am wondering whether or not that line should include an = sign and therefore should read
Code:
If numMakeUps >= 5 Then
    numMakeUps = 4

Maybe it doesn't matter, but...

Tom
 
MajP
I am wondering whether or not a problem lies somewhere in this function:
Code:
Public Function getStreakStart(memID As Long) As Date
  Dim currentMonth As Date
  Dim numMeetings As Integer
  Dim numAttended As Integer
  Dim numMakeUps As Integer
  Dim creditedMeetings
  Dim perfectMonth As Boolean
  Dim dtmEndDate As Variant
  
   On Error GoTo getStreakStart_Error

  dtmEndDate = getEndDate()
  If IsNull(dtmEndDate) Or dtmEndDate = 0 Or Not IsDate(dtmEndDate) Then
    dtmEndDate = DateSerial(Year(Date), Month(Date), 1)
  End If
  
  currentMonth = DateSerial(Year(dtmEndDate), Month(dtmEndDate), 1)
  getStreakStart = currentMonth
  perfectMonth = True
Do Until Not (perfectMonth)
  perfectMonth = False
  numMeetings = getNumberMeetings(currentMonth)
  numAttended = getNumberMeetingsAttended(memID, currentMonth)
  numMakeUps = getNumberMakeUps(memID, currentMonth)
  If numMakeUps > 5 Then
    numMakeUps = 4
  End If
  If numMakeUps + numAttended >= numMeetings Then
    perfectMonth = True
    getStreakStart = currentMonth
    currentMonth = DateSerial(Year(currentMonth), Month(currentMonth) - 1, 1)
  End If
 Loop

   On Error GoTo 0
   Exit Function

getStreakStart_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure getStreakStart of Module mdlStreak"
End Function

If the current month is set to True, and the current month is the end of the streak being checked, is it the case that then even if a member doesn't have perfect in that month the function will return that result?

The reason I ask is this: I used January 2009 as the month to use as the end of the range in which members have consecutive perfect month credits. Every member Active, Senior or Leave of Absence member shows at least 1 month Perfect credit.

However, the following members do not have credit for January: Arnold, Bedard, Bond, Carkner, Catteau, Joan Cotterill, Ken Cotterill, Curtis-Villar, D'Aquilar, Davidson, Donaldson, Duthie and Ferraro. There are others but I only physically checked as far as Ferraro.

Additionally, from the members named above Bond, Burke, Donaldson and Duthie have no perfect Credit months at any point in the database. And Ferraro couldn't have perfect in January 2009 as she didn't join until February 2009.

I'm not clear how to fix the function. And one could argue that it's a moot point since Perfect Attendance awards are only given when a member achieves 12 consecutive months credit, but if it could be fixed to reflect actual results it would be better.

If you would have a suggestion that would be wonderful.

Thanks.

Tom
 
Still have not had a chance to look at this, but I will this week. However, you are right it should read

If numMakeUps > 4 Then
numMakeUps = 4
End If

The above function was designed to return the date when a streak begins given an ending date, not necessarily for showing perfect attendance for a specific month. So if there is no streak for a person it returns the ending date of the streak.

The function should be used in a query and you can put a where statement to return only those records where the streak begin date is greater than the supplied ending date of the streak.
 
MajP
I understand what you are saying. The interesting thing is that the Union query I made that feeds the report runs just as quickly as did the query that was used prior to my constructing the archive process...but when it runs to feed the report it's a lot slower.

I will look forward to any further advice you have.

Tom
 
I can get rid of all of those extra "1" consecutive months by making on additional query based on qryRangePerfect and showing only those whose streak length is greater than 1:
Code:
SELECT qryRangePerfect.MemberID, qryRangePerfect.FullName, qryRangePerfect.StreakStartMonth, qryRangePerfect.StreakLength, qryRangePerfect.EndMonth, qryRangePerfect.LastName, qryRangePerfect.PreferredName, qryRangePerfect.LastPerfectAttendance
FROM qryRangePerfect
WHERE (((qryRangePerfect.StreakLength)>1));

This filters all those who show 1 consecutive months perfect attendance...and those who show 1 even, even if it's correct, are meaningless.

The query still runs slow, but the results appear to be accurate.

Tom


 
yes the function was really designed to show the start of a streak and not perfect attendance for a month. So values of 1 are meaningless. You can use the other functions to show perfect attendance for a given month. You have

getNumberMeetings: which returns the required number of meetings for a given month

getNumberMeetingsAttended: which returns the number of meetings attended by a person for a given month

getNumberMakeUps: which returns the number of makeups for that person for a given month

now wrap these functions in another function

Code:
Public Function isPerfectForMonth(memID As Long, currentMonth As Date) As Boolean
  Dim numMeetings As Integer
  Dim numAttended As Integer
  Dim numMakeUps As Integer
  
  currentMonth = DateSerial(Year(currentMonth), Month(currentMonth), 1)
  numMeetings = getNumberMeetings(currentMonth)
  numAttended = getNumberMeetingsAttended(memID, currentMonth)
  numMakeUps = getNumberMakeUps(memID, currentMonth)
  If numMakeUps > 4 Then
    numMakeUps = 4
  End If
  If numMakeUps + numAttended >= numMeetings Then
    isPerfectForMonth = True
 End If
End Function

The streak function is a pretty expensive function. For each person in the query it runs multiple dcounts and loops. If it becomes unusable then may have to rethink the strategy. Also union queries can be very slow.
 
Majp
Thanks. Actually, the streak queries don't use the union query.

Do you understand why I have to include September 2005 in the tblMonths to keep the function from erroring out, when we only have data from October 2005 on?

Tom
 
I believe that it looks at the last day of the previous month. So there is a little bit of a error checking issue. The user can supply a end date of the range prior to your data. This will cause an error. There needs to be some error checking that endDate is earlier than October 2005.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top