Removing repeating fields from a table: Using VBA

If you have to convert a spreadsheet to a database you will often find that the imported table has repeating fields. Converting this to a better structure can be tedious and error-prone, especially if there are many fields (the limit in Access is 255 fields in a table). This article shows a generic method that you could adapt for converting such a table or tables.

The starting sample

The sample table has one descriptive field (Item) and 30 data fields, each referring to a particular month and containing currency values. You can see a snapshot below.

The lookup table

Each AMT field refers to a particular month so the information was entered into a lookup table. Note that the Header field is a primary key; that is required for the update query to function. There are other ways to generate the lookup / transformation but a lookup table is simple to maintain.

The dummy query

The code writes the transformed data to a query, which is then appended to the final table. To build the starting query make a new query using a single field from any table, and save it as qryDummy.

The final table

The final table has five fields instead of the original 31. As a result there are more rows but the data is much easier to use for reports and queries. There is no need to change fields when querying a different month, and querying ranges of months is also straightforward.

The code

Place the following code into a new module (Alt+F11, Insert > Module, then paste the code)

Function Transform_Table()
    
    Dim dbs As DAO.Database
    Dim tdf As DAO.TableDef
    Dim rst As DAO.Recordset
    Dim sSQL As String, _
        sSQL1 As String, _
        sSQL2 As String
    
    Set dbs = CurrentDb()
    Set rst = dbs.TableDefs("tlkDate").OpenRecordset
    
    'build the first query to transpose the table
    sSQL = ""
    With rst
        .MoveFirst
        Do Until .EOF
            sSQL = sSQL & "SELECT [Item], '" & !Header & "' as [Header], " _
                & "[" & !Header & "] As Amount FROM [TestData] UNION "
            .MoveNext
        Loop
        .Close
    End With
    Set rst = Nothing
    
    sSQL = Left(sSQL, Len(sSQL) - 7)
    dbs.QueryDefs("qryDummy").SQL = sSQL
    
    'SQL to append the data to tblMain
    sSQL1 = "INSERT INTO tblMain ( Item, Header, Amount ) " _
        & "SELECT Q.Item, Q.Header, Q.Amount " _
        & "FROM qryDummy AS Q " _
        & "WHERE Q.Amount Is Not Null"
    'SQL to update the dates
    sSQL2 = "UPDATE tlkDate INNER JOIN tblMain " _
        & "ON tlkDate.Header = tblMain.Header " _
        & "SET tblMain.RefDate = [tlkDate].[LookupValue];"
        
    DoCmd.SetWarnings False
    'delete existing records in the final table. Comment out to leave existing records alone
    DoCmd.RunSQL "DELETE * FROM tblMain"
    
    'run the append and update queries
    DoCmd.RunSQL sSQL1
    DoCmd.RunSQL sSQL2
    DoCmd.SetWarnings True
    
    'clean up references
    dbs.Close
    Set dbs = Nothing
End Function

The code has deliberately been set up to be as generic as possible. You will need to build the lookup table described earlier, and change a couple of field names to suit your needs.