Creating a Date Scale in Excel

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, or you can refer to the javascript version here.
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


Author: bm082975

Leave a Reply

Your email address will not be published. Required fields are marked *