[AccessD] Number Tables and On-The-Fly Normalisation

Interesting article in SQL Server Central about passing an array to a stored procedure and 
using a Number/Tally Table to split the array:

http://www.sqlservercentral.com/articles/T-SQL/63003/

I've recently needed to do exactly this to create a procedure to create a parent and set of 
child records in one step, then return the parent PK.

Playing around with it for a while gave me an few ideas for on-the fly normalising of those 
horrible comma separated fields we sometimes come across in poorly designed Access 
databases.  Following is a complete demo.

1. Create a new MDB.

2. Create a new module.

3. Go into References and enable DAO.

4. Paste the three functions below into the module.

5. Run the MakeNumberTable function to create your Number/Tally table
    I've only filled it with 255 values because that's the max length of a text field
    you can make the table much larger if you are working with memo fields like JC :-)

6. Run the MakeDataTable function to create a set of test data.

7. Now open the two tables just to see what you have got.

8. Run the Normalise function to create and then open the query which makes 
a normalised version of tblData!

9. Take a look at qryNormalise and see if you can understand how it works :-)



Cheers,
Stuart



'----code follows----
Option Compare Database
Option Explicit

Function MakeNumberTable() As Long
    'Create a "Numbers Table" or "Tally Table" and poulate it with series of integers
    Dim tdfNew As DAO.TableDef
    Dim idxNew As Index
    Dim l As Long
    Dim rs As Recordset
    
    'Delete table if it exists
    On Error Resume Next
    DoCmd.DeleteObject acTable, "tblNumbers"
    On Error GoTo 0
    
    'Create table
    Set tdfNew = CurrentDb.CreateTableDef("tblNumbers")
    tdfNew.Fields.Append tdfNew.CreateField("Num", dbLong)
    Set idxNew = tdfNew.CreateIndex("PrimaryKey")
    idxNew.Fields.Append idxNew.CreateField("Num")
    idxNew.Primary = True
    idxNew.Unique = True
    tdfNew.Indexes.Append idxNew
    CurrentDb.TableDefs.Append tdfNew
    
    'Fill table with numbers 1 to 255
    Set rs = CurrentDb.OpenRecordset("tblNumbers")
    For l = 1 To 255
        rs.AddNew
        rs!Num = l
        rs.Update
    Next
End Function

Function MakeDataTable() As Long
    'Create a sample demormalised table with 1000 records
    'each one containing a PK and up to 80 comma separated values
    Dim tdfNew As DAO.TableDef
    Dim idxNew As Index
    Dim fldNew As Field
    Dim rs As Recordset
    Dim l1 As Long
    Dim l2 As Long
    Dim l3 As Long
    
    'Delete the data table if it exists
    On Error Resume Next
    DoCmd.DeleteObject acTable, "tblData"
    On Error GoTo 0
    
    'create a new data table
    Set tdfNew = CurrentDb.CreateTableDef("tblData")
    
    Set fldNew = tdfNew.CreateField("ID", dbLong)
    fldNew.Attributes = dbAutoIncrField + dbFixedField
    tdfNew.Fields.Append fldNew
    
    Set fldNew = tdfNew.CreateField("Data", dbText, 255)
    tdfNew.Fields.Append fldNew
    
    Set idxNew = tdfNew.CreateIndex("PrimaryKey")
    idxNew.Fields.Append idxNew.CreateField("ID")
    idxNew.Primary = True
    idxNew.Unique = True
    tdfNew.Indexes.Append idxNew
    
    CurrentDb.TableDefs.Append tdfNew
    
    'fill the data table with non-normalised data
    Set rs = CurrentDb.OpenRecordset("tblData")
    Randomize Timer
    For l1 = 1 To 1000
        strData = ""
        For l2 = 1 To Int((80) * Rnd + 1)
           strData = strData & "," & Int((100) * Rnd + 1)
        Next
        strData = Mid$(strData, 2)
        rs.AddNew
        rs!Data = strData
        rs.Update
    Next
   
End Function


Function Normalise() As Long
'create a query to normalise the data in tblData using the Numbers Table
'joining it to the string data at character level
Dim qdfNew As QueryDef
Dim strSQL As String

strSQL = "SELECT tblData.ID, Mid$(',' & [data],[Num]+1,InStr([Num]+1,',' & [Data] & ',',',')-
[num]-1) AS DataValue " _
         & "FROM tblData, tblNumbers " _
         & "WHERE Num <= Len(Data) And Mid$(',' & Data,Num,1) = ',' " _
         & "ORDER BY ID, Num;"

Set qdfNew = CurrentDb.CreateQueryDef("qryNormalise", strSQL)
DoCmd.OpenQuery "qryNormalise"
End Function

'----end code ----