Article in pdf format here
Helen Feddema approaches the same problem as Garry (Flexible Normalization and Denormalization of Data) , but this time manages her data to provide the users with the output that met their needs.
A reader asked me how he could convert a table with more than 100 questionnaire fields to a more manageable format, with the fields converted to records in a table to make it easier to tabulate the data. Effectively, this is the reverse of Garry’s problem where he converted multiple records into one: I’m converting a single record into multiple records. To make matters more interesting, my reader wanted to be able to save each survey’s results in a separate table, which forces me to re-create the table and query with each processing run.
In the Helen.mdb file that comes with this article, you’ll find the tblSurvey table (part of which is shown in Figure 1) that has the raw data from the questionnaires. It has 44 fields (cut down from the original table, which had more than 100 fields). There’s a Text field, ID, which is the key field, and the other fields are either Boolean or Text, with the Text fields taking a numeric value from 1 to 5.
To switch the fields to records, I first created a table (with the prefix zstbl to indicate that it’s a system table) with just three fields: SurveyID, a Long Integer field indexed Yes (Duplicates OK), Question and Answer
Public Function CreateResultsTable() On Error Resume Next Dim fld As DAO.Field Dim flds As DAO.Fields Dim rstSource As DAO.Recordset Dim rstTarget As DAO.Recordset Dim strPrompt As String Dim strResultsTable As String Dim strSourceTable As String Dim strTableTemplate As String Dim strTitle As String Dim strReport As String Dim strQuery As String Dim strSQL As String Dim lngCount As Long Dim strCurrentDate As String Dim intResult As Integer Dim rpt As Access.Report
The next step is to delete the existing table for this Survey (if it exists) and re-create it, ready to accept the new data (the surveys were generated each day so I used the current date to name each version of the table):
strTableTemplate = "zstblSurveyResults" strCurrentDate = Format(Date, "dd-mmm-yyyy") strResultsTable = "tblSurveyResults_" & _ strCurrentDate DoCmd.DeleteObject objecttype:=acTable, _ objectname:=strResultsTable On Error GoTo ErrorHandler 'Make copy of table template DoCmd.CopyObject newname:=strResultsTable, _
Figure 1. The table with raw survey data in numerous fields.
Figure 2. A report based on a totals query giving the number of each answer for each question. (both text fields). This table is copied to create a results table that’s filled from code.
The CreateResultsTable function fills a results table with records containing field names and values from the original tblSurvey and creates a totals query based on it (qtotAnswers) that totals the number of Yes, No, and 1 through 5 answers for each question. For convenience, the function can be run from the mcrCreateResultsTable macro, or (for consistency with Garry’s database) the frmCreateResultsTable form. This query is the record source for a simple report, which is shown in Figure 2.
I begin by defining the variables that I’ll be needing:
sourceobjecttype:=acTable, sourceobjectname:=strTableTemplate
Now that the table is created, I can fill it with data. As in Garry’s example, I read each record and then process each field creating a record as I go:
strSourceTable = "tblSurvey" Set dbs = CurrentDb Set rstSource = dbs.OpenRecordset(strSourceTable) Set rstTarget = dbs.OpenRecordset(strResultsTable) Do While Not rstSource.EOF Set flds = rstSource.Fields For Each fld In flds rstTarget.AddNew If fld.Name <> "ID" Then rstTarget![SurveyID] = rstSource![ID] rstTarget![Question] = fld.Name If fld.Type = dbBoolean Then rstTarget![Answer] = _ IIf(fld.Value = True, "Yes", "No") Else rstTarget![Answer] = fld.Value End If rstTarget.Update End If Next fld rstSource.MoveNext Loop rstSource.Close
Reporting on the data
However, the table was only part of the solution. I also needed to create a query that would total the results and serve as the basis for a report. I first deleted any existing copy of the query and then generated a new one:
'Delete old totals query strQuery = "qtotAnswers" DoCmd.DeleteObject objecttype:=acQuery, _ objectname:=strQuery Set dbs = CurrentDb strSQL = "SELECT [" & strResultsTable _ & "].[Question], " _ & "Sum(IIf([Answer]='Yes',1,0)) AS YesAnswer, " _ & "Sum(IIf([Answer]='No',1,0)) AS NoAnswer, " _ & "Sum(IIf([Answer]='1',1,0)) AS 1Answer, " _ & "Sum(IIf([Answer]='2',1,0)) AS 2Answer, " _ & "Sum(IIf([Answer]='3',1,0)) AS 3Answer, " _ & "Sum(IIf([Answer]='4',1,0)) AS 4Answer, " _ & "Sum(IIf([Answer]='5',1,0)) AS 5Answer " _ & "FROM [" & strResultsTable & _ "] GROUP BY [" & strResultsTable & "].[Question];" Debug.Print "SQL for " & strQuery & ": " & strSQL lngCount = CreateAndTestQuery(strQuery, strSQL) Debug.Print "No. of records: " & lngCount If lngCount = 0 Then strPrompt = "No records found; canceling" strTitle = "Canceling" MsgBox strPrompt, vbOKOnly, strTitle GoTo ErrorHandlerExit End If
The final step is to update the report with the current date (stored in the Tag property for display in the txtTitle textbox) and ask the user if they want to view it:
strReport = "rptAnswers" DoCmd.OpenReport reportname:=strReport, _ view:=acViewDesign, windowmode:=acHidden Set rpt = Reports(strReport) rpt.Tag = strCurrentDate strTitle = "Finished" strPrompt = strResultsTable & _ " results table created; open report?" intResult = MsgBox(strPrompt, vbYesNo, strTitle) If intResult = vbYes Then DoCmd.OpenReport reportname:=strReport, _ view:=acViewPreview Else DoCmd.Close objecttype:=acReport, _ objectname:=strReport End If
Finally, exit the function, with an error handler to take care of any errors:
ErrorHandlerExit: Exit Function ErrorHandler: MsgBox "Error No: " & Err.Number & _ "; Description: " & Err.Description Resume ErrorHandlerExit End Function
The CreateAndTestQuery function listed below is handy for creating (and re-creating, as needed) a query in code. I use it to re-create the totals query qtotAnswers, based on the newly created results table (see Figure 2).
Public Function CreateAndTestQuery( _ strTestQuery As String, strTestSQL As String) As Long On Error Resume Next Set dbs = CurrentDb dbs.QueryDefs.Delete strTestQuery On Error GoTo ErrorHandler Set qdf = dbs.CreateQueryDef(strTestQuery, _ strTestSQL) 'Test whether there are any records Set rst = dbs.OpenRecordset(strTestQuery) With rst .MoveFirst .MoveLast CreateAndTestQuery = .RecordCount End With ErrorHandlerExit: Exit Function ErrorHandler: If Err.Number = 3021 Then CreateAndTestQuery = 0 Resume ErrorHandlerExit Else MsgBox "Error No: " & Err.Number & _ "; Description: " & Err.Description Resume ErrorHandlerExit End If End Function
You can find a sample database with all of the code in the accompanying download file. In addition to the Microsoft DAO 3.6 Object Library, my sample database also uses the Scripting Runtime Library.
