Tick list conversion

[janz]

Can any body lead me in the right direction or pref. show me an existing thread or program code.
I need to change a tick list to a 2 column file as below

Tick list has the following fields.
name-A-B-C-X-F-G
JanZ 1 0 1 0 0 0
JanB 0 1 0 1 0 0
Etc

DB 2 has to look as follows
name-fields
JanZ A,C
JanB B,X
etc

The columns names will changes per input the field 'name' will always stay the same.
Please point me in the right direction since I'm lost at the moment.

 

[vbaInet]

You would need to use a function in a query. The function would perform would check each column and concatenate where it finds a 1.

 

[janz]

You would need to use a function in a query. The function would perform would check each column and concatenate where it finds a 1.

Ok, but how do I get the name from the field where it did find a one.
Since I do not know these field names in advance. They are chaning from input to input. So I guess I have to get the field names before I can make the query and do the check. the name of the input table is always the same so any idea how I could get the field names before I upload?

 

[vbaInet]

You would need a recordset for this purpose. I'm assuming you know how to do this?

From the recordset you could get the name of the field.

 

[janz]

I know stuf like

For Each fld In rst.Fields
Debug.Print rst(fld.name)
Next fld

to print each field of a recordset line however I do not know a way to also get the column name for it.

Would you?

 

[vbaInet]

Okay, remember intellisense (the pop-up drop down menu as you type) gives you suggestions of properties/methods associated with that object. So to get the name of a field, you would need to reference the field number (zero-based) and then use the Name property. E.g.:

rst.Fields(0).Name - will give you the name of the first column in the recordset.

 

[janz]

Thanks for your excellent suggestions. I'm done!

here is my rough result for the people interested.

table 1 is the tick table first column needs to be called name the other columns can be any name.

table 2 is the result table
column 1 needs to be called name column 2 to needs to be called tick

The program is my rough draft looks a bid differnt in my project but has all the basics.

Maybe a bid odd to read for some of you but it corresponding to my JSP flow chart (Yes I'm old school)

----------------------------------------------------------------------

Function tickIT()
'JanZ June 2010
'INIT THE NEEDED PARAMETERS
Dim db As Database
Dim rstdb1, rstdb2 As Recordset
Dim sql As String
Dim ResultS As String
Dim skipC, skipCC As Long

'open table one in tick format
Set db = CurrentDb
sql = "SELECT Table1.* FROM Table1;"
Set rstdb1 = db.OpenRecordset(sql)
rstdb1.MoveFirst
'open table2 in named format
sql = "SELECT Table2.name, Table2.tick FROM Table2;"
Set rstdb2 = db.OpenRecordset(sql)
'END INIT THE NEEDED PARAMETERS


'1*1*1 REPEAT FOR ALL LINES IN DB1
Do While rstdb1.EOF = False
ResultS = ""
'1@4@2 ORDER SET COLUMN TO SKIP
skipC = 1
skipCC = 0
'1@4@2 END ORDER SET COLUMN TO SKIP

'2@4@2 DO
'1*1*3 REPEAT FOR ALL COLUMNS
For Each fld In rstdb1.Fields
skipCC = skipCC + 1

'1?3?4 QUESTION SKIP COLUMN
If skipCC <= skipC Or skipCC > rstdb1.Fields.Count - 1 Then
'no action goto next column
'1?3?4 END QUESTION SKIP COLUMN
Else

'1?3?4 QUESTION FOUND A 1
If rstdb1(fld.Name) = 1 Then

ResultS = ResultS & "," & rstdb1.Fields(skipCC).Name

'1?3?4 END QUESTION FOUND A 1

'2?3?4 QUESTION ALL OTHERS
Else

'END 2?3?4 QUESTION ALL OTHERS
End If
End If

Next fld
'1*1*3 END REPEAT FOR ALL COLUMNS

'2@4@2 END ORDER DO

'3@4@2 ORDER SAVE COLUMN
With rstdb2
.AddNew
!Name = rstdb1.Name
!tick = ResultS
.Update


End With
'3@4@2 ORDER END SAVE COLUMN

'4@4@2 ORDER NEXT LINE
rstdb1.MoveNext
'4@4@2 END ORDER NEXT LINE
Loop
'1*1*1 END REPEAT FOR ALL LINES IN DB1

'CLEAN
rstdb1.Close
rstdb2.Close
db.Close
'END CLEAN
End Function

 

[vbaInet]

You're welcome Janz.

By the way, your code could do with some CODE tags for legibility.

 

[boblarson]

You're welcome Janz.

By the way, your code could do with some CODE tags for legibility.

Yes, code tags would be good (so I copied it and used Smart Indenter quickly and here's the results:

Function tickIT()
'JanZ June 2010
'INIT THE NEEDED PARAMETERS
    Dim db As Database
    Dim rstdb1, rstdb2 As Recordset
    Dim sql As String
    Dim ResultS As String
    Dim skipC, skipCC As Long

    'open table one in tick format
    Set db = CurrentDb
    sql = "SELECT Table1.* FROM Table1;"
    Set rstdb1 = db.OpenRecordset(sql)
    rstdb1.MoveFirst
    'open table2 in named format
    sql = "SELECT Table2.name, Table2.tick FROM Table2;"
    Set rstdb2 = db.OpenRecordset(sql)
    'END INIT THE NEEDED PARAMETERS


    '1*1*1 REPEAT FOR ALL LINES IN DB1
    Do While rstdb1.EOF = False
        ResultS = ""
        '1@4@2 ORDER SET COLUMN TO SKIP
        skipC = 1
        skipCC = 0
        '1@4@2 END ORDER SET COLUMN TO SKIP

        '2@4@2 DO
        '1*1*3 REPEAT FOR ALL COLUMNS
        For Each fld In rstdb1.Fields
            skipCC = skipCC + 1

            '1?3?4 QUESTION SKIP COLUMN
            If skipCC <= skipC Or skipCC > rstdb1.Fields.Count - 1 Then
                'no action goto next column
                '1?3?4 END QUESTION SKIP COLUMN
            Else

                '1?3?4 QUESTION FOUND A 1
                If rstdb1(fld.Name) = 1 Then

                    ResultS = ResultS & "," & rstdb1.Fields(skipCC).Name

                    '1?3?4 END QUESTION FOUND A 1

                    '2?3?4 QUESTION ALL OTHERS
                Else

                    'END 2?3?4 QUESTION ALL OTHERS
                End If
            End If

        Next fld
        '1*1*3 END REPEAT FOR ALL COLUMNS

        '2@4@2 END ORDER DO

        '3@4@2 ORDER SAVE COLUMN
        With rstdb2
            .AddNew
            !Name = rstdb1.Name
            !tick = ResultS
            .Update


        End With
        '3@4@2 ORDER END SAVE COLUMN

        '4@4@2 ORDER NEXT LINE
        rstdb1.MoveNext
        '4@4@2 END ORDER NEXT LINE
    Loop
    '1*1*1 END REPEAT FOR ALL LINES IN DB1

    'CLEAN
    rstdb1.Close
    rstdb2.Close
    db.Close
    'END CLEAN
End Function