Questionnaire result (Record to row)

[Bart2013]

Hi all,

Hopefully somebody can help me with a solution or a link to an existing threat.
I get results in from a 164 question questionnaire looking like so:

ID A1 A2 A3 and so on up to A164 (Answer 164)
1001 5 6 2
1002 2 1 4

I need to transfer it into an Access table looking like so:
ID Question Result(or Answer)
1001 1 5
1001 2 6
1001 3 2
1002 1 2
1002 2 1
1002 3 4

Any suggestions please, so far I can't find anything use full and I am not familiar with VBA at all... And it are to much records for a Union query...

Bart

 

[Pat Hartman]

You have two choices. You can create a code loop to read through the rows and columns of the questionnaire table and write normalized records to the result table or you can do it the kurmudgin way and write an append query for each column of the questionnaire to append rows to the results table. If this is a one time conversion, you can just create a singl query and modify it for each new column. If you need to do this on a regular basis, the code solution will be more flexible. I don't have an example I can post but perhaps someone else does.

 

[Bart2013]

Thanks Pat,

I think I better hope for a solution in code. A few union queries and a few append queries will do the trick, but sometimes Access starts complaining that these are to complex. So I don't trust that very much...

Bart

 

[nschroeder]

Bart,
I just posted a suggested solution to a similar issue, so I made a few tweaks to accomodate yours.

Create a form with a button (cbResults). Then add the code to the form:

Option Compare Database
Option Explicit
Dim db As Database
Dim rsQuestions As Recordset
Dim rsResults As Recordset

Private Sub cbResults_Click()
    Set db = CurrentDb()
    Set rsQuestions = db.OpenRecordset("Questions", dbOpenTable)
    Set rsResults = db.OpenRecordset("Results", dbOpenTable)

    With rsQuestions
        Do Until .EOF
            Call WriteResults(1, !A1)
            Call WriteResults(2, !A2)
            Call WriteResults(3, !A3)
            Call WriteResults(4, !A4)
            etc
            .MoveNext
        Loop
    End With

    Set rsQuestions = Nothing
    Set rsResults = Nothing
    Set db = Nothing
End Sub
Private Sub WriteResults(iSeq As Integer, sResult As String)
    With rsResults
        .AddNew
        !ID = rsQuestions!ID
        !IDseq = iSeq
        !Result = sResult
        .Update
    End With
End Sub

If someone knows how to create dynamic field names tied to an iSEQ variable, then that could be put into a for-next loop instead of calling the subroutine 164 times, but I don't know if that's possible. Hope this helps.

 

[CJ_London]

I think this would work:

instead of

 Do Until .EOF
            Call WriteResults(1, !A1)
            Call WriteResults(2, !A2)
            Call WriteResults(3, !A3)
            Call WriteResults(4, !A4)
            etc
            .MoveNext
        Loop

use

 Do Until .EOF
            for i=1 to 164 Call WriteResults(i, !("A" & i) ' I know .fields("A" & i) works. Don't forget to Dim the i as integer
            .MoveNext
        Loop

 

[nschroeder]

CJ, that syntax gives "Compile error: Expected bracketed expression", so I tried it with brackets instead of parentheses, and it likes the syntax, but when you run it, it gives a run-time error 3265 - Item not found in this collection. Any other suggestions?

 

[pr2-eugin]

I think the code CJ gave has a missing Next.. I have modified the code as.. (nothing much but...)

* Instead of Do Until, Try looping with Do While..
* I use .Fields(fieldName) rather than !(fieldName)..

Option Compare Database
Option Explicit
Dim db As Database
Dim rsQuestions As Recordset
Dim rsResults As Recordset

Private Sub cbResults_Click()
    Dim i As Integer
    Set db = CurrentDb()
    Set rsQuestions = db.OpenRecordset("Questions", dbOpenTable)
    Set rsResults = db.OpenRecordset("Results", dbOpenTable)

    With rsQuestions
        Do [COLOR=Blue]While Not[/COLOR] .EOF
            For i=1 to 164 
                Call WriteResults(i, [COLOR=Blue].Fields[/COLOR]("A" & i))
            [COLOR=Blue]Next[/COLOR]
            .MoveNext
        Loop
    End With

    Set rsQuestions = Nothing
    Set rsResults = Nothing
    Set db = Nothing
End Sub

Private Sub WriteResults(iSeq As Integer, sResult As String)
    With rsResults
        .AddNew
        !ID = rsQuestions!ID
        !IDseq = iSeq
        !Result = sResult
        .Update
    End With
End Sub

See if this helps..

 

[CJ_London]

I did, sorry

 

[nschroeder]

That does work. Thanks. But squawking about "Do Until" vs. "Do While"? Seriously?

 

[CJ_London]

Well you can also use

While not .eof
    .movenext
Wend

 

[pr2-eugin]

That does work. Thanks. But squawking about "Do Until" vs. "Do While"? Seriously?

Not squawking, but I have used Do While.. In some case Do Until has not always behaved well, so I tend to use Do While.. It was just a suggestion.. If Do Until works for you.. That's fine..

 

[Bart2013]

Thanks guys! I find it really amazing what you can do with VBA. It is working perfect!

Thanks for your help!

Kind regards,
Bart