Handy SQL Functions: Number List

Sometimes, in SQL group queries, you need totals over a series(e.g. Month numbers 1 to 12). What do you do if some parts of that range have no data but you still want the number in the series displayed?

For instance in our example you have sales data for Month 1,2,3,5 & 6 but there isn't anything for month number 4. You still want Month 4 displayed as a row, just with a null value.

The easiest way to do this is have a small table with numbers 1 to 12 that you can LEFT JOIN on to.

This function will output a table just like that.

CREATE FUNCTION dbo.fnNumberList
(
 @iStart int,
 @iEnd int,
 @iStep int = 1
)  
RETURNS @RtnValue table 
(
 ircNum int
) 

/*
 Returns a table with column name "ircNum" numbers from iStart to iEnd incrementing/decrementing by iStep
 Example:
 select * from dbo.NumberList(4,10,2);
 
 ircNum
 ------
 4
 6
 8
 10
*/

AS  
BEGIN 
 Declare @Cnt int
 Set @Cnt = @iStart

 if @iStep>0 
 While (@Cnt<=@iEnd)
 Begin
  Insert Into @RtnValue (ircNum) VALUES (@Cnt)
  Set @Cnt = @Cnt + @iStep
 End

 if @iStep<0 
 While (@Cnt>=@iEnd)
 Begin
  Insert Into @RtnValue (ircNum) VALUES (@Cnt)
  Set @Cnt = @Cnt + @iStep
 End
 
 Return
END

Handy SQL Functions: Reverse Week Number

I thought it was about time I posted some of the random little functions I've created in SQL that I use now and then.

So here's the first. It's very easy in SQL to get a week number (1..53) from a date - just use "datepart". However doing the reverse isn't. Say, for instance you wanted to know what the date was at the start of week 27 in 2012. How would you go about working that out? Here's my solution.

Just supply the function with the week number and year and out pops the date.

CREATE FUNCTION dbo.fnGetDateFromWeekNo
(@weekNo int , @yearNo  int)
RETURNS smalldatetime
AS
BEGIN 

DECLARE @tmpDate smalldatetime

IF @weekNo<1 set @weekNo=1

set @tmpdate= cast(cast (@yearNo as varchar) + '-01-01' as smalldatetime)
-- jump forward x-1 weeks to save counting through the whole year 
set @tmpdate=dateadd(wk,@weekno-1,@tmpdate)

-- make sure weekno is not out of range
if @WeekNo <= datepart(wk,cast(cast (@yearNo as varchar) + '-12-31' as smalldatetime))
BEGIN
 WHILE (datepart(wk,@tmpdate)<@WeekNo)
 BEGIN
  set @tmpdate=dateadd(dd,1,@tmpdate)
 END
END
ELSE
BEGIN
 -- invalid weeknumber given
 set @tmpdate=null
END


RETURN @tmpDate

END

MS Access Hebrew Dates Class (revisited)

This article has been updated and is now available here.

I've just finished the new version of the Hebrew Dates code.
All thanks to Moishy at Access World Forums for some really useful feedback on the original.
The new version can be downloaded for free via:

• 4Shared
• Access World Forums

Here's a description of the functionality

clsHebrewDate Class
  PROPERTIES
    .HDay
        Read/Write (long)
        stores the value of the current Hebrew day
        When set, the Gregorian Date will automatically be updated.
    .HMonth
        Read/Write (long)
        stores the value of the current Hebrew month
        When set, the Gregorian Date will automatically be updated.
    .HYear
        Read/Write (long)
        stores the value of the current Hebrew year
        When set, the Gregorian Date will automatically be updated.
    .HDaysInMonth
        Read Only (integer)
        returns the number of days in current Hebrew month.
    .GDate
        Read/Write (date)
        stores the value of the current Gregorian Date
        When set, the Hebrew Date will automatically be updated.
    .GAfterSunset
        Read/Write (boolean)
        used to mark the Gregorian date as occuring after sunset.
        NB: Gregorian days start at midnight but Hebrew days start
        after sunset
        TRUE = After sunset
        FALSE = Before sunset
        When set, the Hebrew Date will automatically be updated.
    .IsHLeapyear
        Read Only (boolean)
        Returns TRUE if the current Hebrew Year is a Hebrew leapyear
        NB: Hebrew leap years include a whole extra month (Adar II)
        and occur in a pattern that follows a 19 year cycle (see below)
    .IsValid
        Read Only (boolean)
        Returns TRUE if the current Hebrew Date is valid
  METHODS
    .Copy()
        Function returns clsHebrewDate type
        Creates and returns a new copy of the current instance
        of the clsHebrewDate class.
    .SetHebrewDate()
        Sets the Hebrew date and automatically updates the Gregorian
        date.
    .YahrzeitStep([,])
        Alters the current Hebrew Date moving it forward or backward
        x years according to the value of YearStep in accordance with
        the selected algorithm selected by CalcStyle.
        NB: You should always calculate additional Yahrzeit dates from
        the orginal date of the aneversary. DO NOT be tempted to calc
        a Yahrzeit from a previous Yahrzeit! This will lead to errors!
        YearStep: integer value can be positive or negative
        CalcStyle: (OPTIONAL)
                    1: Traditional (DEFAULT)
                    2: Reform
                    3: CatchAll

Module modHebrewDate
Function's
 GetHebrewMonthsList(bLeapYear As Boolean) As Variant
  returns a list of month numbers and their names delimited with semicolons
  this is particularly useful for generating combobox dropdown lists
  NB: Hebrew leap years have a extra month, hence the need for bLeapYear 
  to specify if the list should generate months for a leap year

 FormatHDate(myDate As clsHebrewDate, myFormat As Variant) As Variant
  Format hebrew date and output as a variant string.
  Variant string is needed so unicode letters can be used i.e. for Hebrew text
  the format parameters are based on the ones uses in PHP. See http://php.net/manual/en/function.date.php
  Format codes:
   Misc
    \ escape character
   Day
                d Date, 2 digits with leading zeros (00..30)
                f Textual representation of date as stored in the language table (HDate01..HDate30)
                j Date as number without leading zeros (1..30)
                l NB: this is a lowercase letter L
     Textual representation of the day of the week as stored in the language table (HDay1..HDay7)
                S English ordinal suffix for the day of the month, 2 characters (st, nd, rd, th)
                w returns 1..7 where 1=Sunday (Yom Rishon)
   Month
                F Textual representation of a month as stored in the language table
     (HMonth01..05, HMonth07..13, HMonth06Leap, HMonth07Leap)
                m Numeric representation of a month, with leading zeros (01..13)
                n Numeric representation of a month, without leading zeros (1..13)
                t Number of days in the given month (29..30)
   Year
                L Whether it's a leap year (1=yes 0=no)
                Y A full numeric representation of a year, all digits (eg 5758)
                y A two digit representation of a year (eg 58)
   Time
                a Textual representation of time of day in the Gregorian Date part as stored in Language Table (GTimeNight, GTimeDay)
Sub's
 SetHebrewDateFromGUI(ByRef MyHebrewDate As clsHebrewDate)
  Shows a hebrew date picker dialog box and returns any selected date back to the carable passed to MyHebrewDate
  NB: if you prefer the dialog box to display in Right to Left mode and have days that change according to the hebrew
  rather than the gregorian calendar (i.e. at sunset rather than midnight) edit the dlgHebDatePick13/14 form and set
  Const CDisplayRTL = True
  
  
  

Change Trigger - Log all data changes in a table

I needed a MSSQL trigger to store alterations to data in a table called tblContacts. All changes (i.e. the before & after values) needed to be stored in a table that logs all changes from various tables.

tblAudit Structure

irpEditRecordID (int)
dwoEditDate (datetime)
swoUser (nvarchar)
cwoAction (char)
swoRecordID (nvarchar)
swoSourceTable (nvarchar)
swoSourceField (nvarchar)
swoBeforeValue (sql_variant)
swoAfterValue (sql_variant)

This is a bit quick and nasty, and probably a bit slow if you've got a table that really gets hammered but it suits my needs. The trigger below will spin through all available fields looking for changes and log them in tblAudit. The payoff is I don't need to remember to update the trigger if I add new fields!

tblContacts Update Trigger

SET QUOTED_IDENTIFIER ON 
GO
SET ANSI_NULLS ON 
GO

-- Change the trigger name below to reflect your table name
CREATE TRIGGER trg_tblContacts_Update

-- Change the table name below to reflect the table you want to audit
ON dbo.tblContacts

FOR UPDATE

AS

DECLARE @sField    VARCHAR(255)
DECLARE @sTable    VARCHAR(255)
DECLARE @sPrimaryKey  VARCHAR(255)
DECLARE @sSQL    VARCHAR(3000)

-- SETTINGS --
-- Change the table name below to reflect the table you want to audit
SET @sTable = 'tblContacts'
-- Change the primary key below to reflect the primary key field for table you want to audit
SET @sPrimaryKey = 'irpContact'

-- INIT --
SET @sSQL = ''

SELECT  * INTO #temp_inserted FROM inserted;
SELECT  * INTO #temp_deleted FROM deleted;


DECLARE fields_cursor CURSOR FOR 
 SELECT column_name FROM information_schema.columns
  WHERE table_name = @sTable
 ORDER BY ordinal_position
OPEN fields_cursor

-- CHECK CHANGES TO DATA IN EACH FIELD --

FETCH NEXT FROM fields_cursor INTO @sField

WHILE @@FETCH_STATUS = 0
BEGIN

 -- Find and log changes in tblAudit
 SET @sSQL = ' INSERT INTO tblAudit  (dwoEditDate,swouser,cwoAction,swoRecordID,swoSourceTable,swoSourceField, swoBeforeValue,swoAfterValue) ( select GETUTCDATE() as calc_datestamp, system_user as calc_username, ''A'' as calc_status, #temp_inserted.' + @sPrimaryKey + ', ''' + @sPrimaryKey + ''' as calc_TableName, ''' + @sField + ''' as calc_fieldname,  #temp_deleted.' + @sField + ', #temp_inserted.' + @sField + ' from #temp_inserted , #temp_deleted  where (#temp_deleted.' + @sPrimaryKey + ' = #temp_inserted.' + @sPrimaryKey + ') AND (#temp_inserted.' + @sField + ' != #temp_deleted.' + @sField + ' ) ) '
 
--PRINT @sSQL
 EXEC(@sSQL)

 FETCH NEXT FROM fields_cursor INTO @sField
END

CLOSE fields_cursor
DEALLOCATE fields_cursor



GO
SET QUOTED_IDENTIFIER OFF 
GO
SET ANSI_NULLS ON 
GO

Displaying a 6 digit number as 4 text characters

Recently I had to link up 2 systems, one financial off the shelf package and a bespoke Access database used for contact management.
The contact management data was going to create and maintain customer accounts in the financial package. The problem was in the access DB each contact had a unique number and in the financial package we needed a reference where the first 2 letters of the customers surname were followed with up to 4 more characters for a unique reference.
Tricky.
In the end I put together this short bit of code that allows you to convert a number to any base. All you have to do is supply the digits to use.
In my case I've used base 33 to pack the id numbers into a shorter format using numbers and letters.

Const vbB2Digits = "01" 'base 2 - Binary
Const vbB8Digits = "01234567" 'base 8 - Octal
Const vbB10Digits = "0123456789" 'base 10 - Decimal
Const vbB10Digits = "0123456789XE" 'base 12 - Dozenal. See http://www.dozenal.org
Const vbB16Digits = "0123456789ABCDEF" 'base 16 - Hexedecimal
Const vbB33Digits = "0123456789ABCDEFGHJKMNPQRSTUVWXYZ" 'base 33 - non similar characters (I,L,O removed) from 0-9 & Alphabet


Public Function sEncodeNumber(lNumber As Long, Optional sDigitList As String = vbB10Digits) As String
Dim sOutputString As String
Dim lTmpNumber As Long
Dim lRangeSize As Long
Dim lTmpPower As Long
Dim lTmpLastPower As Long

    OutputString = ""
    lTmpNumber = lNumber
    lRangeSize = Len(sDigitList)
    lTmpPower = 1

    ' Work with postive numbers
    If lTmpNumber < 0 Then
        lTmpNumber = lTmpNumber * -1
    End If

    While lTmpNumber > 0
        lTmpLastPower = lTmpPower
        lTmpPower = lTmpPower * lRangeSize
        sOutputString = Mid(sDigitList, ((lTmpNumber Mod lTmpPower) / lTmpLastPower) + 1, 1) & sOutputString
        lTmpNumber = lTmpNumber - (lTmpNumber Mod lTmpPower)
    Wend

    ' insert the -ve sign if the orginal number was negative
    If lNumber < 0 Then
        sOutputString = "-" & sOutputString
    End If

    sEncodeNumber = sOutputString
End Function

For those maths geeks out there, if you haven't come across dozenal before, have a quick gander at Alex Bellos' blog entires on the subject.

MSSQL Calls through ODBC in MS Access

As MS Access no longer supports .adp projects any Access databases created have to link to MS-SQL back ends through ODBC.
However, sometimes you still need to call Stored Procedures, Views or create dynamic query statements to be passed directly to MS-SQL.

You can still achieve this by creating a passthru query in Access.

Below is a little bit of code I put together to allow you to run SQL statements using a passthru query called "SQLCall" or choosing one of your own.

To set things up, you'll need to create a passthru query in Access (see http://support.microsoft.com/kb/303968 for how to do this) called SQLCall and then drop this code into a module:

Public Sub SQLExec(ByVal sSQL As String _
 , Optional bRetRecords As Boolean = False _
 , Optional bExecute As Boolean = True _
 , Optional sQueryName As String = "SQLCall" _
 , Optional vConnect As Variant)
 
' vConnect   : Optional connection string
' bRetRecords   : Optional set return records on / off. Default: on
' sQueryName : Optional set alternate location for query storage

On Error GoTo ErrorHandler

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim sConnect As String

 Set db = CurrentDb
 Set qdf = db.QueryDefs(sQueryName)
 If IsMissing(vConnect) Then
  sConnect = qdf.Connect
 Else
  sConnect = CStr(vConnect)
 End If
 
 qdf.SQL = sSQL
 qdf.Connect = sConnect
 qdf.ReturnsRecords = bRetRecords
 If bExecute Then qdf.Execute

 GoTo ErrorExit
ErrorHandler:
 Select Case Err.Number
 Case Else
  MsgBox cErrorIntro & vbCrLf _
  & vbCrLf & Err.Number _
  & vbCrLf & Err.Description _
  & vbCrLf & Err.Source _
  , vbCritical + vbOKOnly, "Error"
 End Select
 Resume Next
ErrorExit:
End Sub

You can use this Sub to do thinks like:

Call the untag all contacts stored procedure

SQLExec "EXEC spUntagAllContacts;", False, True

Delete Contact #5

SQLExec "DELETE FROM tblContacts Where ContactID = 5;"

Call the SP to tag a contact based on ContactID

SQLExec "EXEC spTagContact " & Nz(ContactID, 0) & ";"

Do a select query and make the results accessible from the SQLContactList passthru

SQLExec "SELECT * from tblContacts WHERE ContactID < 100;", True, False, "SQLContactList"

Call the stored procedure to get the current users security groups and make the results accessible from the SQLSecurityGroupList passthru

SQLExec "EXEC spListMySecurityGroups '" & UserName & "';", True, False, "SQLSecurityGroupList"

Viewing a Nested Set Model tree as an Adjacency List

Recently, I needed to view a Nested Set Model tree as an Adjacency list so I could use it with VB's TreeCtrl.

Here's the MS-SQL view I came up with:

SELECT   T1.irpCategory, T1.iwmleft, T1.iwmright, T1.swmCategoryName, T1.ircDepth, T2.ircParentID
FROM     (SELECT   TOP 100 PERCENT node.irpCategory, node.iwmleft, node.iwmright, node.swmCategoryName, (COUNT(parent.swmCategoryName) - 1) 
                       AS ircDepth
            FROM     dbo.tblCategories AS node, dbo.tblCategories AS parent
            WHERE   node.iwmleft BETWEEN parent.iwmleft AND parent.iwmright
            GROUP BY node.irpCategory, node.swmCategoryName, node.iwmleft, node.iwmright
            ORDER BY node.iwmleft) T1 LEFT OUTER JOIN
             (SELECT   TOP 100 PERCENT irpCategory,
                            (SELECT   TOP 1 irpCategory
                             FROM     dbo.tblCategories t2
                             WHERE   t2.iwmleft < t1.iwmleft AND t2.iwmright > t1.iwmright
                             ORDER BY t2.iwmright - t1.iwmright ASC) AS ircParentID
              FROM     dbo.tblCategories t1
              ORDER BY iwmright - iwmleft DESC) T2 ON T1.irpCategory = T2.irpCategory

And the VB for the TreeCtrl object called tvCategories:

Private Sub Refresh_tvCategories()
On Error GoTo Err_Handler
Dim vNodeSet As Variant
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim bFirstItem As Boolean
Dim sFirstKey As String
    Set db = CurrentDb
    'SQLCategoriesList is a odbc passthru query to the view on the MSSQL server
    Set rs = db.OpenRecordset("SELECT * FROM SQLCategoriesList")
    bFirstItem = True
    
    
    If Not rs.EOF Then
        rs.MoveFirst
        While Not rs.EOF
                        

            If IsNull(rs.Fields("ircParentID")) Then
                Set vNodeSet = tvCategories.Nodes.Add()
                vNodeSet.Key = "K" & rs.Fields("irpCategory")
                vNodeSet.Expanded = False
                vNodeSet.Text = rs.Fields("swmCategoryName")
            Else
                'Tree Controls need text for their IDs so I'm prefixing the ID numbers with the letter K
                Set vNodeSet = tvCategories.Nodes.Add("K" & rs.Fields("ircParentID"), tvwChild)
                vNodeSet.Key = "K" & rs.Fields("irpCategory")
                vNodeSet.Expanded = False
                vNodeSet.Text = rs.Fields("swmCategoryName")
            End If
            If bFirstItem Then
                sFirstKey = vNodeSet.Key
                bFirstItem = False
            End If
            rs.MoveNext
        Wend
    End If
    
    'for some reason the form doesnt work properly unless an item has been selected at some point
    tvCategories.Nodes(sFirstKey).Selected = True
    'it can be unslected straight away
    
    
    
Exit_Err_Handler:
    Exit Sub
    
Err_Handler:
    Select Case Err.Number
       Case vbObjectError + 1
          Resume Next
       Case Else
          msgbox Err.Number & Err.Description
          Resume Exit_Err_Handler
    End Select

End Sub

MSSQL Calcluate age from Date of Birth

This excerpt will convert a date of birth into an age. It returns NULL when no DoB is present.

CASE WHEN T.dwoDOB IS NULL THEN NULL 
 ELSE 
 CASE WHEN DATEADD(YEAR, DATEDIFF (YEAR, T.dwoDOB, CURRENT_TIMESTAMP), T.dwoDOB) > CURRENT_TIMESTAMP 
 THEN DATEDIFF(YEAR, T.dwoDOB, CURRENT_TIMESTAMP) - 1 
 ELSE DATEDIFF(YEAR, T.dwoDOB, CURRENT_TIMESTAMP)
 END 
END

Example

SELECT 
T.swmFirstName, T.swmLastName,
ircAge = 
   CASE
      WHEN 
         T.dwoDOB IS NULL 
      THEN
         NULL 
      ELSE
         CASE 
            WHEN
               DATEADD(YEAR, DATEDIFF (YEAR, T.dwoDOB, CURRENT_TIMESTAMP), T.dwoDOB) > CURRENT_TIMESTAMP 
            THEN
               DATEDIFF(YEAR, T.dwoDOB, CURRENT_TIMESTAMP) - 1 
            ELSE 
               DATEDIFF(YEAR, T.dwoDOB, CURRENT_TIMESTAMP) 
         END
   END
FROM T as tblContacts