Okay, this is a little sloppy, but it seems to work.
Your tblRates should have: RateID, RoomCategory, DayOfWeek, and Price fields. If the names are different, you'll have to fix the code.
This was an interesting challenge!
Public Function DisplayRates(strCategory As String, datStart As Date, datEnd As Date, Optional intDisplayDates As Integer = 0) As String
Dim strDisplayRates As String, datNow As Date, curNow As Currency
Dim db As DAO.Database, rst As DAO.Recordset
Dim intDay As Integer, curRate As Currency, strDay As String, intNoPrice As Integer
Dim curPrevRate As Currency, datPrevDay As Date, intPrevDay As Integer, strDayCompare As String, strLongDayCompare As String
' Point to this database
Set db = CurrentDb
' Open the rates table
Set rst = db.OpenRecordset("SELECT * FROM tblRates")
' Loop through the dates
For datNow = datStart To datEnd - 1
' Get the day of the week of this date (Monday = 1)
intDay = Weekday(datNow, 2)
' Get the name of the day as an abbreviation
strDay = WeekdayName(intDay, True, 2)
' Look up the rate for this day
rst.FindFirst "RoomCategory = '" & strCategory & "' AND DayOfWeek = " & intDay
If rst.NoMatch Then
' Ooops - either an invalid category or the day isn't in the table
' Return error string
DisplayRates = "ERR - category or day of week not found."
' Get out
GoTo Bail
End If
curNow = rst!Price
' See if we got the same rate as previous
If curNow <> curPrevRate Then
' Need to update the return string
GoSub RateChange
' If this was the end of an entry,
If Right(strDisplayRates, 1) = ";" Then
' Change to today's date
curPrevRate = curNow
datPrevDay = datNow
intPrevDay = intDay
' Tell the sub to NOT add the price
intNoPrice = True
' And call it again to start the next one
GoSub RateChange
intNoPrice = False
End If
End If
' Save the current values
curPrevRate = curNow
datPrevDay = datNow
intPrevDay = intDay
' Loop
Next datNow
datPrevDay = datNow
intPrevDay = intDay
curPrevRate = curNow
' Process the last entry
GoSub RateChange
' Return the answer
DisplayRates = strDisplayRates
Bail:
' Close out
rst.Close
Set rst = Nothing
Set db = Nothing
Exit Function
RateChange:
' If string is empty,
If Len(strDisplayRates) = 0 Then
' Start of string, so just put in the date info
' If asked to display full date,
If intDisplayDates Then
' Put the full date in the string
strDisplayRates = Format(datNow, "Long Date")
Else
' Just put the day name
strDisplayRates = strDay
End If
Else
' Terminate the previous entry and put in the rate
' If this is a single date, string will end in ;
' .. and won't match the previous day name
If (Right(strDisplayRates, 1) <> ";") And _
(strLongDayCompare <> Format(datPrevDay, "Long Date")) And _
(strDayCompare <> WeekdayName(intPrevDay, True, 2)) Then
' Not a single date, so add a dash
strDisplayRates = strDisplayRates & " -"
End If
' Put in the date -
' But not if it matches what we did last time through!
If (strLongDayCompare <> Format(datPrevDay, "Long Date")) And _
(strDayCompare <> WeekdayName(intPrevDay, True, 2)) Then
If intDisplayDates Then
' Save for next time around
strLongDayCompare = Format(datPrevDay, "Long Date")
' Put the full date in the string
strDisplayRates = strDisplayRates & " " & strLongDayCompare
Else
' Save for next time around
strDayCompare = WeekdayName(intPrevDay, True, 2)
' Just put the day name
strDisplayRates = strDisplayRates & " " & strDayCompare
End If
End If
' Check to see if we need to add the price
If Not intNoPrice Then
' Add the price and end with a ;
strDisplayRates = strDisplayRates & " " & Format(curPrevRate, "$#,##0") & ";"
End If
End If
Return
End Function
John Viescas, Author
Effective SQL
SQL Queries for Mere Mortals
Microsoft Access 2010 Inside Out
Microsoft Access 2007 Inside Out
Microsoft Access 2003 Inside Out
Building Microsoft Access Applications
(Paris, France)
Hi John
Of course! I see the logic of your proposed table structure. I'm going to change the tables accordingly.
I think I shall use an int for DayOfWeek corresponding to the result of Access' Weekday function (with Monday being the first day of the week).
You assume correctly that some help with the function would be appreciated :-)
Lance
John wrote:
