Math problem in a function

[Don G]

Hello there,

Using Access 2003 I have a weekly schedule for 40 cars, numbered 1 through
41, there is no 13.

The original line up for the cars is a column that from top to bottom is 1
through 41, there being no 13 and this being week 1.

Every new week the car at the top goes to the bottom and everything shifts
up 1 spot.

In Excel two copy and pastes for each week would will get the results I want
but I would like to use a query rather than import a 40 column spreadsheet
but I'm lost in the math.

Any direction or suggestions would be greatly appreciated.

Here is what I've got so far but it ends up with two 14s or a 13 and 14, and
a number missing from the list.

Public Function WeekLineUp(Car As Integer) As Integer
'purpose: to get the car line up for the week of any given date

Dim RealWeek As Long
Dim SchedWeek As Long

' Calculate actual week. ----> Date to be replaced by a form entry
RealWeek = DateDiff("ww", "Nov 1, 2009", Date, vbSunday)

' ActualWeeks runs on a 40 week cycle
RealWeek = RealWeek Mod 40
If RealWeek = 0 Then RealWeek = 40

' The Schedule Week
SchedWeek = IIf(RealWeek < 13, RealWeek, RealWeek + 1)

' This is here for manually entering different weeks for testing
SchedWeek = 1

' The WeekLineUp
WeekLineUp = Car + SchedWeek - 1

' Trying to correct the numbers
If WeekLineUp = 13 Then WeekLineUp = 14
If WeekLineUp > 41 Then WeekLineUp = WeekLineUp - 41

End Function

Thanks for looking
Don

 

[kc-mass]

How about you have a table with numbers 1 to 41 with no 13.

Then have a procedure that is seeded by the first car# of lastweek.

Air code like :

Sub CarNumbers()
Dim db as database
Dim rs as Recordset
Dim intCarCount as integer
Set db = currentdb
Set rs = db.openrecordset("qryCars") ' A list of the cars ordered by
last weeks order
intCarCount = 1
If not rs.EOF and not rs.BOF then
rs.MoveFirst
rs.MoveNext
Else
MsgBox "Data Error"
Exit Sub
Endif
Do While intCarCount <= 40
rs.Edit
rs.CarCount = intCarCount
rs.update
intCarCount = intCarCount + 1
rs.MoveNext
If rs.EOF
rs.movefirst
Endif
Loop
rs.Close
Set db = nothing
Set rs = Nothing
Endsub


Regards

Kevin

 

[Don G]

How about you have a table with numbers 1 to 41 with no 13.

Then have a procedure that is seeded by the first car# of lastweek.

Air code like :

Sub CarNumbers()
Dim db as database
Dim rs as Recordset
Dim intCarCount as integer
Set db = currentdb
Set rs = db.openrecordset("qryCars") ' A list of the cars ordered by
last weeks order
intCarCount = 1
If not rs.EOF and not rs.BOF then
rs.MoveFirst
rs.MoveNext
Else
MsgBox "Data Error"
Exit Sub
Endif
Do While intCarCount <= 40
rs.Edit
rs.CarCount = intCarCount
rs.update
intCarCount = intCarCount + 1
rs.MoveNext
If rs.EOF
rs.movefirst
Endif
Loop
rs.Close
Set db = nothing
Set rs = Nothing
Endsub


Regards

Kevin





.
Thanks Kevin.

I'm sure I can use your suggested direction to produce a full 40 column
schedule.

I thought it would be a lot cleaner to generate the schedule for any given
date "on the fly" and was really hopeful someone would be able to help tweak
the function I posted.

Thanks
Don

 

[Don G]

Got it.
Had to number original lineup from 1 through 40 including 13 and then adjust
the results like this:

Public Function WeekLineUp(Car As Integer) As Integer
'purpose: to get the car line up for the week of any given date

Dim RealWeek As Long
Dim SchedWeek As Long

' Calculate actual week. -----> Date to be replaced by a form entry
RealWeek = DateDiff("ww", "Nov 1, 2009", Date, vbSunday)
' ActualWeeks runs on a 40 week cycle
RealWeek = RealWeek Mod 40
If RealWeek = 0 Then RealWeek = 40
' The Schedule Week
SchedWeek = IIf(RealWeek < 13, RealWeek, RealWeek + 1)

' This is here for manually entering different weeks for testing
'SchedWeek = 1

' The WeekLineUp
WeekLineUp = Car + SchedWeek - 1

' Try to correct the numbers
If WeekLineUp > 12 Then WeekLineUp = WeekLineUp + 1
If WeekLineUp > 41 And WeekLineUp < 54 Then WeekLineUp = WeekLineUp - 41
If WeekLineUp > 53 Then WeekLineUp = WeekLineUp - 40

End Function