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.
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364 Private Function limitofScale(scaleType As String, sd As Date, fd As Date, edge As edgeTick) As VariantDim dLastDayOfFinishScale As Date, dFirstDayOfStartScale As VariantDim ss As String, sf As String, ticks As SingleSelect Case Trim(LCase(scaleType))Case "weeks"dFirstDayOfStartScale = sddLastDayOfFinishScale = fd + 7 - (Weekday(fd) Mod 7)ss = Format(sd, "dd-mmm-yy")sf = Format(fd, "dd-mmm-yy")ticks = (dLastDayOfFinishScale - dFirstDayOfStartScale + 1) / 7Case "months"' 1st day of start monthdFirstDayOfStartScale = DateSerial(Year(sd), Month(sd), 1)' last of finish monthdLastDayOfFinishScale = DateSerial(Year(fd), Month(fd) + 1, 1) - 1ss = Format(sd, "mmm-yyyy")sf = Format(fd, "mmm-yyyy")ticks = (dLastDayOfFinishScale - dFirstDayOfStartScale + 1) / 30Case "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) - 1ss = "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) / 90Case "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) - 1ss = "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) / 183Case "years"dFirstDayOfStartScale = DateSerial(Year(sd), 1, 1)dLastDayOfFinishScale = DateSerial(Year(fd) + 1, 1, 1) - 1ss = Format(sd, "yyyy")sf = Format(fd, "yyyy")ticks = (dLastDayOfFinishScale - dFirstDayOfStartScale + 1) / 365Case ElseMsgBox "Invalid scale choice " & scaleTypeExit FunctionEnd SelectSelect Case edgeCase etStartlimitofScale = dFirstDayOfStartScaleCase etFinishlimitofScale = dLastDayOfFinishScaleCase etFinishStringlimitofScale = sfCase etStartStringlimitofScale = ssCase etEstimatedTickslimitofScale = ticksCase ElseDebug.Assert FalseEnd SelectEnd 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.
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950 Private Function AutoScale() As StringDim ticks As Single, tickDiff As SingleDim idealticks As Single, sBest As String, s As StringDebug.Assert pscType = sctframeidealticks = maxticks * 0.5tickDiff = maxticks + 1s = "weeks"ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks)If Abs(idealticks - ticks) < tickDiff ThensBest = stickDiff = Abs(idealticks - ticks)End Ifs = "months"ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks)If Abs(idealticks - ticks) < tickDiff ThensBest = stickDiff = Abs(idealticks - ticks)End Ifs = "quarters"ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks)If Abs(idealticks - ticks) < tickDiff ThensBest = stickDiff = Abs(idealticks - ticks)End Ifs = "halfyears"ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks)If Abs(idealticks - ticks) < tickDiff ThensBest = stickDiff = Abs(idealticks - ticks)End Ifs = "years"ticks = limitofScale(s, Activate, deActivate, etEstimatedTicks)If Abs(idealticks - ticks) < tickDiff ThensBest = stickDiff = Abs(idealticks - ticks)End IfIf tickDiff > maxticks ThenMsgBox "Couldnt find a feasible automatic scale to use for roadmap " & IDEnd IfAutoScale = sBestEnd Function
Be the first to comment