Updated Date Lookup

[spl]

Script updated to auto-create the Excel Table. Very useful for vLookups or conversions to lookup tables for Power BI, SQL Server, Access etc.. Current code covers 2023-2024 but easy to modify or create a dialog to accept start/end dates and format as yyyy,m,d for variable replcement in mCode.

Code Select Expand

; Winbatch 2022C - Creating Power Query Rolling Calendar
; Requires Excel 2010/2013 with Power Query Add-On or 2016 which comes with it
; Tested with Excel 2016 64 bit
; Script is WB 32 bit
;
; Stan Littlefield, June 14, 2024
;
; NOTE: This is an update from a script first posted in 2018
;      Can easily be modified to select specfic start and end dates with a dialog.
;      Excel does not save to file, but that could be added.
;===========================================================================================================

IntControl(73,1,0,0,0)
Gosub udfs

;set date range parameters
startdate = "2023,1,1"
enddate = "2024,12,31"

If ! loadxl(0,1) Then Terminate(@TRUE,"Cannot Continue","Unable To Load Excel")

BoxOpen("Please Wait","Creating Power Query Lookup Calendar...")

f=$"let
    StartDate = ##date(|sd|),
    EndDate = ##date(|ed|),
    ##"List of Dates" = List.Dates( StartDate, Duration.Days( EndDate - StartDate ) +1, ##duration( 1, 0, 0, 0 ) ),
    ##"Converted to Table" = Table.FromList( ##"List of Dates", Splitter.SplitByNothing(), type table[Date = Date.Type] ),
    ##"Insert Date Integer" = Table.AddColumn(##"Converted to Table", "Date Integer", each Number.From( Date.ToText( [Date], "yyyyMMdd" ) ), Int64.Type ),
    ##"Insert Year" = Table.AddColumn(##"Insert Date Integer", "Year", each Date.Year([Date]), Int64.Type),
    ##"Insert YYYY-MM" = Table.AddColumn(##"Insert Year", "YYYY-MM", each Date.ToText( [Date], "yyyy-MM"), type text),
    ##"Insert Month-Year" = Table.AddColumn(##"Insert YYYY-MM", "Month-Year", each Date.ToText( [Date], "MMM yyyy"), type text),
    ##"Insert Month Number" = Table.AddColumn(##"Insert Month-Year", "Month Of Year", each Date.Month([Date]), Int64.Type),
    ##"Insert Month Name" = Table.AddColumn(##"Insert Month Number", "Month Name", each Date.MonthName([Date], "EN-us"), type text),
    ##"Insert Month Name Short" = Table.AddColumn(##"Insert Month Name", "Month Name Short", each Date.ToText( [Date] , "MMM", "EN-us" ), type text),
    ##"Insert Start of Month" = Table.AddColumn(##"Insert Month Name Short", "Start of Month", each Date.StartOfMonth([Date]), type date),
    ##"Inserted End of Month" = Table.AddColumn(##"Insert Start of Month", "End of Month", each Date.EndOfMonth( [Date] ), type date),
    ##"Inserted Days in Month" = Table.AddColumn(##"Inserted End of Month", "Days in Month", each Date.DaysInMonth([Date]), Int64.Type),
    ##"Add ISO Week" = Table.AddColumn(##"Inserted Days in Month", "ISO Weeknumber", each let
    CurrentThursday = Date.AddDays([Date], 3 - Date.DayOfWeek([Date], Day.Monday ) ),
    YearCurrThursday = Date.Year( CurrentThursday ),
    FirstThursdayOfYear = Date.AddDays(##date( YearCurrThursday,1,7),- Date.DayOfWeek(##date(YearCurrThursday,1,1), Day.Friday) ),
    ISO_Week = Duration.Days( CurrentThursday - FirstThursdayOfYear) / 7 + 1
in  ISO_Week, Int64.Type ),
    ##"Add ISO Year" = Table.AddColumn(##"Add ISO Week", "ISO Year", each Date.Year(  Date.AddDays( [Date], 26 - [ISO Weeknumber] ) ), Int64.Type ),
    ##"Insert Start of Week" = Table.AddColumn(##"Add ISO Year", "Start of Week", each Date.StartOfWeek([Date], Day.Monday ), type date),
    ##"Insert Quarter Number" = Table.AddColumn(##"Insert Start of Week", "Quarter Number", each Date.QuarterOfYear([Date]), Int64.Type),
    ##"Added Quarter" = Table.AddColumn(##"Insert Quarter Number", "Quarter", each "Q" & Text.From( Date.QuarterOfYear([Date]) ), type text ),
    ##"Add Year-Quarter" = Table.AddColumn(##"Added Quarter", "Year-Quarter", each Text.From( Date.Year([Date]) ) & "-Q" & Text.From( Date.QuarterOfYear([Date]) ), type text ),
    ##"Insert Day Name" = Table.AddColumn(##"Add Year-Quarter", "Day Name", each Date.DayOfWeekName([Date], "EN-us" ), type text),
    ##"Insert Day Name Short" = Table.AddColumn( ##"Insert Day Name", "Day Name Short", each Date.ToText( [Date], "ddd", "EN-us" ), type text),
    // Day.Monday indicates the week starts on Monday. Change this in case you want the week to start on a different date.
    ##"Insert Day of Week" = Table.AddColumn(##"Insert Day Name Short", "Day of Week Number", each Date.DayOfWeek( [Date], Day.Monday ), Int64.Type),
    ##"Insert Is Weekend" = Table.AddColumn(##"Insert Day of Week", "Is Weekend", each if Date.DayOfWeek( [Date] ) >= 5 then 1 else 0, Int64.Type ),
    ##"Insert Is Weekday" = Table.AddColumn(##"Insert Is Weekend", "Is Weekday", each if Date.DayOfWeek( [Date] ) < 5 then 1 else 0, Int64.Type )
in
    ##"Insert Is Weekday"$"

 f = Strreplace(f,"|sd|",startdate)
 f = Strreplace(f,"|ed|",enddate)
 oWS = oXL.ActiveWorkbook.Worksheets.Item(1)
 qry = "Dates"
 oWS.Name = qry
 oXL.ActiveWorkBook.Queries.Add(::Name=qry,Formula=f,Description="Query")
 cSource = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=%qry%;Extended Properties=''"
 qt = oWS.ListObjects.Add(::SourceType=0,Source=cSource,Destination=oWS.Range("$A$1")).QueryTable
 qt.CommandText = "Select * FROM [%qry%]"
 qt.Refresh()
 oWS=0

BoxText("Done...Review Dates":@LF:"then either save or discard")
TimeDelay(5)
BoxShut()

oXL=0

Exit

:WBERRORHANDLER
geterror()
oXL=0
Exit

:udfs
#DefineSubRoutine loadxl(mode,visible)
IntControl(73,2,0,0,0)
oXL = CreateObject("Excel.Application")
If oXL == 0 Then Return(0)
If mode
  oXL.WorkBooks.Open(cXLS)
Else
  oXL.WorkBooks.Add()
Endif
While ! oXL.Ready
  TimeDelay(1)
EndWhile
;TimeDelay(5)
oXL.Visible          = visible  ;if 0 then Excel will not be visible, 1= visible
;message("","debug")
oXL.ScreenUpdating  = 1  ;these next 3 increase speed of processing
oXL.UserControl      = 1
oXL.DisplayAlerts    = 0
oXL.UpdateLinks      = 0
Return(1)

:WBERRORHANDLER
IntControl(73,2,0,0,0)
Return(0)

#EndFunction

#DefineSubRoutine geterror()
  wberroradditionalinfo = wberrorarray[6]
  lasterr = wberrorarray[0]
  handlerline = wberrorarray[1]
  textstring = wberrorarray[5]
  linenumber = wberrorarray[8]
  errmsg = "Error: ":lasterr:@LF:textstring:@LF:"Line (":linenumber:")":@LF:wberroradditionalinfo
  Return(errmsg)
#EndSubRoutine

Return