Sometimes you have a range of dates and you need to come up with a scale that makes sense for the dates you are trying to represent in a timeline. For example if your dates range across a year or so, you may want to break the scale into months, 2 or 3 years, quarters would be better and perhaps weeks would be best if the scale is a few months.
I came across this problem when working on a roadmap generator for Excel, and later with a port to javascript to embed it in a Google Gadget.
Once you have decided on a scale, you also need to figure out how to line up the scale at the end of the month, quarter or whatever you have chosen. Below is some useful VBA code to do all that.
Calculating the end of the ‘period’
Here is a function that will return various pieces of information a range such as the effective start date, effective finish date, number of ticks and so on given a start date and a finish date. You may find the calculations for end of quarter etc helpful, since they took me a little while to get right.
Private Function limitofScale(scaleType As String, sd As Date, fd As Date, edge As edgeTick) As Variant Dim dLastDayOfFinishScale As Date, dFirstDayOfStartScale As Variant Dim ss As String, sf As String, ticks As Single Select Case Trim(LCase(scaleType)) Case "weeks" dFirstDayOfStartScale = sd dLastDayOfFinishScale = fd + 7 - (Weekday(fd) Mod 7) ss = Format(sd, "dd-mmm-yy") sf = Format(fd, "dd-mmm-yy") ticks = (dLastDayOfFinishScale - dFirstDayOfStartScale + 1) / 7 Case "months" ' 1st day of start month dFirstDayOfStartScale = DateSerial(Year(sd), Month(sd), 1) ' last of finish month dLastDayOfFinishScale = DateSerial(Year(fd), Month(fd) + 1, 1) - 1 ss = Format(sd, "mmm-yyyy") sf = Format(fd, "mmm-yyyy") ticks = (dLastDayOfFinishScale - dFirstDayOfStartScale + 1) / 30 Case "quarters" dFirstDayOfStartScale = DateSerial(Year(sd), Month(sd) - ((Month(sd) - 1) Mod 3), 1) dLastDayOfFinishScale = DateSerial(Year(fd), Month(fd) + 3 - ((Month(fd) - 1) Mod 3), 1) - 1 ss = "Q" & CStr(1 + Int((Month(sd) - 1) / 3)) & Format(sd, "yyyy") sf = "Q" & CStr(1 + Int((Month(fd) - 1) / 3)) & Format(fd, "yyyy") ticks = (dLastDayOfFinishScale - dFirstDayOfStartScale + 1) / 90 Case "halfyears" dFirstDayOfStartScale = DateSerial(Year(sd), Month(sd) - ((Month(sd) - 1) Mod 6), 1) dLastDayOfFinishScale = DateSerial(Year(fd), Month(fd) + 6 - ((Month(fd) - 1) Mod 6), 1) - 1 ss = "H" & CStr(1 + Int((Month(sd) - 1) / 6)) & Format(sd, "yyyy") sf = "H" & CStr(1 + Int((Month(fd) - 1) / 6)) & Format(fd, "yyyy") ticks = (dLastDayOfFinishScale - dFirstDayOfStartScale + 1) / 183 Case "years" dFirstDayOfStartScale = DateSerial(Year(sd), 1, 1) dLastDayOfFinishScale = DateSerial(Year(fd) + 1, 1, 1) - 1 ss = Format(sd, "yyyy") sf = Format(fd, "yyyy") ticks = (dLastDayOfFinishScale - dFirstDayOfStartScale + 1) / 365 Case Else MsgBox "Invalid scale choice " & scaleType Exit Function End Select Select Case edge Case etStart limitofScale = dFirstDayOfStartScale Case etFinish limitofScale = dLastDayOfFinishScale Case etFinishString limitofScale = sf Case etStartString limitofScale = ss Case etEstimatedTicks limitofScale = ticks Case Else Debug.Assert False End Select End Function
Finding the most appropriate scale
In this case we are looking for the ‘best’ scale to use given a start and finish date and a maximum number of axis ticks.
Private Function AutoScale() As String Dim ticks As Single, tickDiff As Single Dim idealticks As Single, sBest As String, s As String Debug.Assert pscType = sctframe idealticks = maxticks * 0.5 tickDiff = maxticks + 1 s = "weeks" ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks) If Abs(idealticks - ticks) < tickDiff Then sBest = s tickDiff = Abs(idealticks - ticks) End If s = "months" ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks) If Abs(idealticks - ticks) < tickDiff Then sBest = s tickDiff = Abs(idealticks - ticks) End If s = "quarters" ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks) If Abs(idealticks - ticks) < tickDiff Then sBest = s tickDiff = Abs(idealticks - ticks) End If s = "halfyears" ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks) If Abs(idealticks - ticks) < tickDiff Then sBest = s tickDiff = Abs(idealticks - ticks) End If s = "years" ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks) If Abs(idealticks - ticks) < tickDiff Then sBest = s tickDiff = Abs(idealticks - ticks) End If If tickDiff > maxticks Then MsgBox "Couldnt find a feasible automatic scale to use for roadmap " & ID End If AutoScale = sBest End Function
