Jump ahead one month

[Cardinal]

I have a room reservation app that several forum members have been
kind enough to help me with over the last few weeks. There is a blue
rightward pointing arrow head at the top of the form that progresses
the users through the room reservation **one day at a time**. Please
see link.

http://209.200.80.147/test/SampleForm.html

The code for this button was suggested by a forum member and it works
splendidly:

Private Sub ButtonName_Click()
On Error GoTo Err_ButtonName_Click
DoCmd.GoToRecord , , acNext
Exit_ButtonName_Click:
Exit Sub
Err_ButtonName_Click:
MsgBox "This is the last record", vbOKOnly, "Please stop pressing
me"
Resume Exit_ButtonName_Click
End Sub


My question: Is there code that I could use on a new and different
button that would advance it **one month** at a time. This is so the
user would not have to click the blue next record button scores of
times if they wanted to enter a room reservation a month or two in
advance. Thank you very much.

 

[ruralguy via AccessMonster.com]

Is there one and only one record for each day and is it already in the table?
How would you get the date of the current record?

 

[Ken Sheridan]

If you want to move to the same day in the next month use this:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = DateAdd("m", 1, Me.[YourDateField])
strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and edit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

Note that with the above, if you are on the last day of the month, say 31
January, it will next go to 28 or 29 February, depending in whether it’s a
leap year, but will then go to 28 or 29 March, i.e. it won't readjust itself
back to the last day of the month again. It would be possible with a little
extra code to get it to do that, but it would really be second guessing the
user's intentions as if you start from 28 February, who knows whether you
want to go to the last day of each succeeding month or stay on the 28th of
each month?

Alternatively if you want to move to the first day of the next month,
regardless of what day of the month you start from, then use this,
substituting the real name for YourDateField:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = _
DateSerial(Year(Me.[YourDateField]), _
Month(Me.[YourDateField]) + 1, 1)

strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and exit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

Ken Sheridan
Stafford, England

 

[Beetle]

Hello Ken

This is unelated to the op, but I'm cuious about something because I
consider you among the most knowledgable an helpful responders
in the ng.

I've noticed you usually use constants for messages, etc. whereas
many people (myself included) would use a string variable. Is there
an advantage to using a constant?
--
_________

Sean Bailey

If you want to move to the same day in the next month use this:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = DateAdd("m", 1, Me.[YourDateField])
strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and edit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

Note that with the above, if you are on the last day of the month, say 31
January, it will next go to 28 or 29 February, depending in whether it’s a
leap year, but will then go to 28 or 29 March, i.e. it won't readjust itself
back to the last day of the month again. It would be possible with a little
extra code to get it to do that, but it would really be second guessing the
user's intentions as if you start from 28 February, who knows whether you
want to go to the last day of each succeeding month or stay on the 28th of
each month?

Alternatively if you want to move to the first day of the next month,
regardless of what day of the month you start from, then use this,
substituting the real name for YourDateField:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = _
DateSerial(Year(Me.[YourDateField]), _
Month(Me.[YourDateField]) + 1, 1)

strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and exit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

Ken Sheridan
Stafford, England

I have a room reservation app that several forum members have been
kind enough to help me with over the last few weeks. There is a blue
rightward pointing arrow head at the top of the form that progresses
the users through the room reservation **one day at a time**. Please
see link.

http://209.200.80.147/test/SampleForm.html

The code for this button was suggested by a forum member and it works
splendidly:

Private Sub ButtonName_Click()
On Error GoTo Err_ButtonName_Click
DoCmd.GoToRecord , , acNext
Exit_ButtonName_Click:
Exit Sub
Err_ButtonName_Click:
MsgBox "This is the last record", vbOKOnly, "Please stop pressing
me"
Resume Exit_ButtonName_Click
End Sub


My question: Is there code that I could use on a new and different
button that would advance it **one month** at a time. This is so the
user would not have to click the blue next record button scores of
times if they wanted to enter a room reservation a month or two in
advance. Thank you very much.

 

[Ken Sheridan]

Sean:

Firstly, thank you for your kind words. I only wish I deserved them!

The use of constants in my code in this thread illustrates two things:

1. The conNEWRECORD constant is used to hold the error number (94) which
will occur if the form is at an empty new record when the button is clicked.
This makes the code more readable as you can see what the error number
represents. It also makes it easier when writing the code as once you've
declared the constant its easy to use it when trapping the anticipated error
without having to remember what the number is each time. In a simple
procedure like this one where only one anticipated error condition is being
trapped this doesn't make a great deal of difference, but in more complex
procedures where different error conditions are handled then it helps both
the readability of the code and when writing it. I've also included a
comment to make clear what this error means and what's done about it (in this
case its just ignored).

2. The conMESSAGE constant is declared instead of a variable as the message
is a fixed string expression so rather than declaring a variable and then
assigning a string to it, it can all be done in one line. In other
circumstances, where the message will change depending on circumstances, then
a string variable would be used of course. Here's an example from the
NotInList event procedure of a combo box, where the string is build to
include the new value entered into the combo box:

Dim ctrl As Control
Dim strSQL As String, strMessage As String

Set ctrl = Me.ActiveControl
strMessage = "Add " & NewData & " to list?"

strSQL = "INSERT INTO Cities(City) VALUES(""" & _
NewData & """)"

The other thing you might have noticed is that I use upper case characters
for constants. It used to be a convention that constants were always
declared using upper case, but it tends not to be done so much these days.
Being a dyed in the wool luddite, though. I've stuck with it.

Ken Sheridan
Stafford, England

Hello Ken

This is unelated to the op, but I'm cuious about something because I
consider you among the most knowledgable an helpful responders
in the ng.

I've noticed you usually use constants for messages, etc. whereas
many people (myself included) would use a string variable. Is there
an advantage to using a constant?
--
_________

Sean Bailey

If you want to move to the same day in the next month use this:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = DateAdd("m", 1, Me.[YourDateField])
strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and edit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

Note that with the above, if you are on the last day of the month, say 31
January, it will next go to 28 or 29 February, depending in whether it’s a
leap year, but will then go to 28 or 29 March, i.e. it won't readjust itself
back to the last day of the month again. It would be possible with a little
extra code to get it to do that, but it would really be second guessing the
user's intentions as if you start from 28 February, who knows whether you
want to go to the last day of each succeeding month or stay on the 28th of
each month?

Alternatively if you want to move to the first day of the next month,
regardless of what day of the month you start from, then use this,
substituting the real name for YourDateField:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = _
DateSerial(Year(Me.[YourDateField]), _
Month(Me.[YourDateField]) + 1, 1)

strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and exit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

Ken Sheridan
Stafford, England

I have a room reservation app that several forum members have been
kind enough to help me with over the last few weeks. There is a blue
rightward pointing arrow head at the top of the form that progresses
the users through the room reservation **one day at a time**. Please
see link.

http://209.200.80.147/test/SampleForm.html

The code for this button was suggested by a forum member and it works
splendidly:

Private Sub ButtonName_Click()
On Error GoTo Err_ButtonName_Click
DoCmd.GoToRecord , , acNext
Exit_ButtonName_Click:
Exit Sub
Err_ButtonName_Click:
MsgBox "This is the last record", vbOKOnly, "Please stop pressing
me"
Resume Exit_ButtonName_Click
End Sub


My question: Is there code that I could use on a new and different
button that would advance it **one month** at a time. This is so the
user would not have to click the blue next record button scores of
times if they wanted to enter a room reservation a month or two in
advance. Thank you very much.

 

[Beetle]

Thanks for the response Ken.

Always trying to learn new things, keep the synapses firing.
--
_________

Sean Bailey

Sean:

Firstly, thank you for your kind words. I only wish I deserved them!

The use of constants in my code in this thread illustrates two things:

1. The conNEWRECORD constant is used to hold the error number (94) which
will occur if the form is at an empty new record when the button is clicked.
This makes the code more readable as you can see what the error number
represents. It also makes it easier when writing the code as once you've
declared the constant its easy to use it when trapping the anticipated error
without having to remember what the number is each time. In a simple
procedure like this one where only one anticipated error condition is being
trapped this doesn't make a great deal of difference, but in more complex
procedures where different error conditions are handled then it helps both
the readability of the code and when writing it. I've also included a
comment to make clear what this error means and what's done about it (in this
case its just ignored).

2. The conMESSAGE constant is declared instead of a variable as the message
is a fixed string expression so rather than declaring a variable and then
assigning a string to it, it can all be done in one line. In other
circumstances, where the message will change depending on circumstances, then
a string variable would be used of course. Here's an example from the
NotInList event procedure of a combo box, where the string is build to
include the new value entered into the combo box:

Dim ctrl As Control
Dim strSQL As String, strMessage As String

Set ctrl = Me.ActiveControl
strMessage = "Add " & NewData & " to list?"

strSQL = "INSERT INTO Cities(City) VALUES(""" & _
NewData & """)"

The other thing you might have noticed is that I use upper case characters
for constants. It used to be a convention that constants were always
declared using upper case, but it tends not to be done so much these days.
Being a dyed in the wool luddite, though. I've stuck with it.

Ken Sheridan
Stafford, England

Hello Ken

This is unelated to the op, but I'm cuious about something because I
consider you among the most knowledgable an helpful responders
in the ng.

I've noticed you usually use constants for messages, etc. whereas
many people (myself included) would use a string variable. Is there
an advantage to using a constant?
--
_________

Sean Bailey

If you want to move to the same day in the next month use this:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = DateAdd("m", 1, Me.[YourDateField])
strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and edit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

Note that with the above, if you are on the last day of the month, say 31
January, it will next go to 28 or 29 February, depending in whether it’s a
leap year, but will then go to 28 or 29 March, i.e. it won't readjust itself
back to the last day of the month again. It would be possible with a little
extra code to get it to do that, but it would really be second guessing the
user's intentions as if you start from 28 February, who knows whether you
want to go to the last day of each succeeding month or stay on the 28th of
each month?

Alternatively if you want to move to the first day of the next month,
regardless of what day of the month you start from, then use this,
substituting the real name for YourDateField:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = _
DateSerial(Year(Me.[YourDateField]), _
Month(Me.[YourDateField]) + 1, 1)

strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and exit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

Ken Sheridan
Stafford, England

:

I have a room reservation app that several forum members have been
kind enough to help me with over the last few weeks. There is a blue
rightward pointing arrow head at the top of the form that progresses
the users through the room reservation **one day at a time**. Please
see link.

http://209.200.80.147/test/SampleForm.html

The code for this button was suggested by a forum member and it works
splendidly:

Private Sub ButtonName_Click()
On Error GoTo Err_ButtonName_Click
DoCmd.GoToRecord , , acNext
Exit_ButtonName_Click:
Exit Sub
Err_ButtonName_Click:
MsgBox "This is the last record", vbOKOnly, "Please stop pressing
me"
Resume Exit_ButtonName_Click
End Sub


My question: Is there code that I could use on a new and different
button that would advance it **one month** at a time. This is so the
user would not have to click the blue next record button scores of
times if they wanted to enter a room reservation a month or two in
advance. Thank you very much.

 

[Cardinal]

If you want to move to the same day in the next month use this:

    On Error Goto Err_Handler

    Const conNEWRECORD = 94
    Const conMESSAGE = "You have requested a date " & _
        "beyond the last date in the table."
    Dim rst As Object
    Dim dtmDate As Date
    Dim strCriteria As String

    Set rst = Me.Recordset.Clone

    dtmDate = DateAdd("m", 1, Me.[YourDateField])
    strCriteria = "[YourDateField] = #" & _
        Format(dtmDate, "yyyy-mm-dd") & "#"

    With rst
        .FindFirst strCriteria
        If Not .NoMatch Then
            Me.Bookmark = .Bookmark
        Else
            MsgBox conMESSAGE, vbInformation, "Warning"
        End If
    End With

Exit_Here:
    Exit Sub

Err_Handler:
    Select Case Err.Number
        Case conNEWRECORD
        ' form is at new record, so
        ' ignore error and edit procedure
        Case Else
        ' unknown error so inform user
        MsgBox Err.Description, vbExclamation, "Error"
    End Select
    Resume Exit_Here

I used the above code and it did jump ahead one month at a time but
when I click again to move another month ahead, it gives me an error
message of, "You have requested a date beyond the last date in the
table." If I click on the next button a couple of times to advance it
one day at a time, THEN click on the "ahead one month button," it
works for a couple of clicks then gives me the same error message
again. For what it's worth, this hits against a date table with dates
that go to 2013. Do you have any idea what might be causing this?
Thanks for the time you've already put into this.

 

[Cardinal]

I forgot to mention from my previous post that the date table only has
business week dates in it. No weekend dates are listed.

 

[John Spencer]

Try changing the criteria line to read >= instead of just =
strCriteria = "[YourDateField] >= #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

The problem with this may be if your records are not sorted in date order.
The problem is that you don't have weekend dates and so when the findfirst
tries to find a date one month in the future and the date falls on saturday or
sunday, it can't find the date and so set the .NoMatch to true.

John Spencer
Access MVP 2002-2005, 2007-2008
The Hilltop Institute
University of Maryland Baltimore County

If you want to move to the same day in the next month use this:

On Error Goto Err_Handler

Const conNEWRECORD = 94
Const conMESSAGE = "You have requested a date " & _
"beyond the last date in the table."
Dim rst As Object
Dim dtmDate As Date
Dim strCriteria As String

Set rst = Me.Recordset.Clone

dtmDate = DateAdd("m", 1, Me.[YourDateField])
strCriteria = "[YourDateField] = #" & _
Format(dtmDate, "yyyy-mm-dd") & "#"

With rst
.FindFirst strCriteria
If Not .NoMatch Then
Me.Bookmark = .Bookmark
Else
MsgBox conMESSAGE, vbInformation, "Warning"
End If
End With

Exit_Here:
Exit Sub

Err_Handler:
Select Case Err.Number
Case conNEWRECORD
' form is at new record, so
' ignore error and edit procedure
Case Else
' unknown error so inform user
MsgBox Err.Description, vbExclamation, "Error"
End Select
Resume Exit_Here

I used the above code and it did jump ahead one month at a time but
when I click again to move another month ahead, it gives me an error
message of, "You have requested a date beyond the last date in the
table." If I click on the next button a couple of times to advance it
one day at a time, THEN click on the "ahead one month button," it
works for a couple of clicks then gives me the same error message
again. For what it's worth, this hits against a date table with dates
that go to 2013. Do you have any idea what might be causing this?
Thanks for the time you've already put into this.

 

[Cardinal]

Your slight code modification made it work perfectly. Thank you very
much.