rows to column 1

[KevDBF]

Hi all

This is probably a stupid question but...

I have a table with 59,000 records of unique data. I need to take 57 fields per record make a single column of data out of it but stamp each of the 57 records with the unique ID of the record.

I.e.
[ID][field1][field2][field3] etc...

to

[ID][field1]
[ID][field2]
[ID][field3]

etc...

If I can get the field names as well as values then I'll be really happy but I can do this as a seperate process if need.

Thanks in advance

Also posted (by mistake) onto the forms forum...

http://www.tek-tips.com/viewthread.cfm?qid=1303136&page=1

 

[PHV]

Say you have created a table tblNew with 3 fields: ID, fname, fvalue.
You may run 57 append queries like this:
INSERT INTO tblNew (ID, fname, fvalue)
SELECT ID, "field1", field1
FROM tblOld
WHERE field1 IS NOT NULL

If you know how to play with Recordset in VBA you may even automate the whole process.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[TheAceMan1]

How are ya KevDBF . . .

[blue]I hope the 57 fields are the same data type!?[/blue] . . . since there now going in the same column, else some conversions may have to be made along the way! . . .

[blue]Your Thoughts? . . .[/blue]

See Ya! . . . . . .

 

[KornGeek]

This was also done in a recent thread using a Union query. If only I could remember the thread...

 

[KornGeek]

Found it...

thread701-1302321

 

[MichaelRed]

a bit long and with limitations but works for 'transposing' using the FIRST column of a recordset. If YOUR table doesn't have the column you want to be the piviot, use a query as the source recordset with that colomn (the piviot column) as the first field o teh query.


[

CODE
Option Compare Database
Option Explicit

    Type MyFldType
        FldName As String
        FldType As String
        FldSize As Integer
    End Type
Function basXpose(strSource As String, Optional ByVal strTarget As Variant)

    Dim dbs As DAO.Database
    Dim rstSrc As DAO.Recordset
    Dim rstDest As DAO.Recordset
    Dim Idx As Integer
    Dim Jdx As Integer
    Dim Kdx As Integer
    Dim Ldx As Integer
    Dim MyStatus As Long
    Dim MyDest As String
    
    On Error GoTo ErrExit

    If (IsMissing(strTarget)) Then
        MyDest = strSource & "Xpose"
     Else
        MyDest = strTarget
    End If

    Set dbs = CurrentDb()
    Set rstSrc = dbs.OpenRecordset(strSource)

    'Seperate routine to create the table
    MyStatus = basCreXposeTbl(strSource, MyDest)
    If (MyStatus <> 0) Then
        MsgBox "Err(" & MyStatus & ") " & Error(Err), vbCritical, "File Creation Error"
        GoTo ErrExit
    End If

    'Open the New table, to populate it's fields with the source recordset records
    rstSrc.MoveFirst
    Set rstDest = dbs.OpenRecordset(MyDest, dbOpenDynaset)

    'Fill each Field of the tblNew (rstDest) _
     with a record from the recordset in the input argument (rstSrc).
    Idx = 1
    While Idx < rstSrc.Fields.Count         '(1 to 11)
        Jdx = 0
        rstSrc.MoveFirst
       'Begin with the second field, because the first field _
        already contains the field names.


        With rstDest
           .AddNew

            If (Jdx = 0) Then
                .Fields(Jdx) = rstSrc.Fields(Idx).Name
                Jdx = Jdx + 1
            End If

            Do While Jdx < rstDest.Fields.Count - 1         '(1 to 128)
                .Fields(Jdx) = Trim(rstSrc.Fields(Idx).Value)
                rstSrc.MoveNext
                If (rstSrc.EOF = True) Then
                   Exit Do
                End If
                Jdx = Jdx + 1
            Loop

            .Update
        End With

        Idx = Idx + 1

    Wend

    Set rstSrc = Nothing
    Set rstDest = Nothing
    dbs.Close

   Exit Function

ErrExit:

   Select Case Err

      Case 3010
         MsgBox "The table " & strTarget & " already exists."

      Case 3078
         MsgBox "The table " & strSource & " doesn't exist."

        Case 3191   'Camnnot define field more than once
         MsgBox "Camnnot define field more than once"

      Case Else
         MsgBox CStr(Err) & " " & Err.Description
   End Select

   Exit Function

End Function
Public Function basValdName(strIn As String) As String

    'To remove Invalid Characters and Spaces from "proposed" field Names

    Dim Idx As Long
    Dim Jdx As Long
    Dim blnVldChr As Boolean
    Dim MyChr As String * 1
    Dim strOut As String
    Dim InVldChrs(30) As String * 1
    Dim blnWhtSpc As Boolean

    InVldChrs(0) = "."
    InVldChrs(1) = "/"
    InVldChrs(2) = "\"
    InVldChrs(3) = "&"
    InVldChrs(4) = "^"
    InVldChrs(5) = "%"
    InVldChrs(6) = "*"
    InVldChrs(7) = "("
    InVldChrs(8) = ")"
    InVldChrs(9) = "!"

    InVldChrs(10) = "@"
    InVldChrs(11) = "#"
    InVldChrs(12) = "$"
    InVldChrs(13) = "<"
    InVldChrs(14) = ">"
    InVldChrs(15) = "?"
    InVldChrs(16) = "+"
    InVldChrs(17) = " "
    InVldChrs(18) = "{"
    InVldChrs(19) = "}"

    InVldChrs(20) = "["
    InVldChrs(21) = "]"
    InVldChrs(22) = "|"
    InVldChrs(23) = Chr(34)
    InVldChrs(24) = Chr(39)
    InVldChrs(25) = ""
    InVldChrs(26) = ""
    InVldChrs(27) = ""
    InVldChrs(28) = ""
    InVldChrs(29) = ""

    InVldChrs(30) = ""


    
    Idx = 1
    While Idx <= Len(strIn)

        MyChr = Mid(strIn, Idx, 1)
        If (Idx = 1) Then
            If (IsNumeric(MyChr)) Then
                strOut = "_" & MyChr
            End If
        End If

        Jdx = 0
        blnVldChr = True
        Do While Jdx <= UBound(InVldChrs)

            If (MyChr = InVldChrs(Jdx)) Then
                blnVldChr = False
                blnWhtSpc = True
                Exit Do
            End If

            Jdx = Jdx + 1
        Loop

        If (blnVldChr = True) Then
            If (blnWhtSpc = True) Then
                strOut = strOut & UCase(MyChr)
                blnWhtSpc = False
             Else
                strOut = strOut & MyChr
            End If
        End If

        Idx = Idx + 1
    Wend

    basValdName = strOut

End Function
Public Function basCreXposeTbl(strSource As String, strTarget As String) As Long

    Dim dbs As DAO.Database
    Dim rstSrc As DAO.Recordset
    Dim tblNew As TableDef
    Dim fldNew As DAO.Field
    Dim MyNewFld As String
    Dim MyFld() As MyFldType
    Dim FldLen() As String

    Dim Idx As Long
    Dim Jdx As Long
    Dim Kdx As Long
    Dim MyFldLen As Integer


    On Error GoTo ErrExit

    Set dbs = CurrentDb()
    Set rstSrc = dbs.OpenRecordset(strSource)

    'Get a valid record count from the Source Table
    
    Idx = rstSrc.RecordCount
    ReDim MyFld(Idx)
    ReDim FldLen(Idx)
    rstSrc.MoveFirst

    'First field name Derived from the Field Name of Field(0)
    MyFld(0).FldName = basValdName(rstSrc.Fields(0).Name)

    'Remaiining field names from field(0) values
    Idx = 1
    While Not rstSrc.EOF

        MyFld(Idx).FldName = basValdName(rstSrc.Fields(0).Value)

        rstSrc.MoveNext
        Idx = Idx + 1
    Wend

    'Here with a supposed set of field names in an array.  Need to _
     check for dups and adjust to make sure there are none
    Idx = 0
    While Idx <= UBound(MyFld) - 1
        Kdx = 1

        Jdx = Idx + 1
        While Jdx <= UBound(MyFld) - 1

            If (MyFld(Jdx).FldName = MyFld(Idx).FldName) Then
                'Aparent Dup - so add a suffix
                MyFld(Jdx).FldName = MyFld(Jdx).FldName & "_" & Trim(Str(Kdx))
                Kdx = Kdx + 1
            End If

            Jdx = Jdx + 1
        Wend

        Idx = Idx + 1
    Wend

    'Here to get the field Types and (for Text fields) the Sizes
    Idx = 1
    rstSrc.MoveFirst
    While Not rstSrc.EOF
        MyFldLen = 1
        Jdx = 1

        While Jdx <= rstSrc.Fields.Count - 1

            If (Not IsNull(Len(Trim(rstSrc.Fields(Jdx))))) Then
                MyFldLen = Len(Trim(rstSrc.Fields(Jdx)))
                If (MyFldLen > MyFld(Idx).FldSize) Then
                    MyFld(Idx).FldSize = MyFldLen
                End If
            End If

            Jdx = Jdx + 1
        Wend

        Idx = Idx + 1
        rstSrc.MoveNext
    Wend

    ' Create a new table to hold the transposed data.
    Set tblNew = dbs.CreateTableDef(strTarget)

    'Create a field for each record in the original table, with _
     field names derived from the First Column of the Source Recordset.

    Idx = 0
    While Idx <= UBound(MyFld)

        With tblNew
            .Fields.Append .CreateField(MyFld(Idx).FldName, dbText, MyFld(Idx).FldSize)
        End With

        Idx = Idx + 1
   Wend

    'Actually Save the New table with the fields (all are text!)
    dbs.TableDefs.Append tblNew

    'Show the new table in the dbWindow
    RefreshDatabaseWindow

    Set rstSrc = Nothing
    Set dbs = Nothing

ErrExit:
    basCreXposeTbl = Err

End Function
Public Function basXferPlanInfo(strTblIn As String, strTblOut As String) As Boolean

    Dim dbs As DAO.Database
    Dim rstSrc As DAO.Recordset
    Dim rstDest As DAO.Recordset

    Dim Idx As Integer
    Dim Jdx As Integer
    Dim Kdx As Integer
    Dim strSQl As String
    Dim MyFld As Variant
    Dim MySrcFld As String
    Dim MyDestFld As String

    strSQl = "Delete * from " & strTblOut & ";"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQl
    DoCmd.SetWarnings True

    Set dbs = CurrentDb
    Set rstSrc = dbs.OpenRecordset(strTblIn, dbOpenDynaset)
    Set rstDest = dbs.OpenRecordset(strTblOut, dbOpenDynaset)

    While Not rstSrc.EOF        'The Whole magillia

        Idx = 0

        With rstDest

            .AddNew

                While Idx < rstSrc.Fields.Count
                    MySrcFld = rstSrc.Fields(Idx).Name      'Get the name of the source field

                    'Seperate routine to return the content of "Boolean" fields _
                     (Could by "Y", "N", Other String, oor Null
                    If (rstDest(MySrcFld).Type = dbBoolean) Then
                        MyFld = basChkBlnContent(rstSrc("Company"), rstSrc("ServicePlan"), MySrcFld)
                     Else
                        'Not Boolean, just copy it
                        rstDest(MySrcFld) = rstSrc(MySrcFld)
                        GoTo NoBool
                    End If

                    If (Not IsNull(MyFld)) Then
                        'Something there, Where to Place it?
                        If (MyFld = "N") Then       'Is it a No?
                            rstDest(MySrcFld) = False
                         Else
                            rstDest(MySrcFld) = Null
                        End If
                    End If
                        
                    If (MyFld = "Y") Then
                        rstDest(MySrcFld) = True
                    End If
                    If (Len(MyFld) > 1) Then
                        rstDest(MySrcFld & "Desc") = MyFld
                    End If

NoBool:

                    Idx = Idx + 1       'rstSrc Field Index

                Wend        'Idx (Index of rstDest.Fields.Count)

            .Update

        End With            'rstSrc

        rstSrc.MoveNext         'Next Source Record

    Wend

End Function
Public Function basChkBlnContent(ByVal MyCpny As String, _
                                 ByVal MyPln As String, _
                                 Optional ByVal MyFld As Variant) As Variant

    Dim dbs As DAO.Database
    Dim rstSrc As DAO.Recordset

    Set dbs = CurrentDb
    Set rstSrc = dbs.OpenRecordset("tblSvcPlnXpose", dbOpenDynaset)

    'Routine to check for "boolean" fields which actually contains Text. _
     Where this occurs, Return the Text in the source recordset field, _
     otherwise, return Null.  The Calling procedure will set the corresponding _
     Text field to the Value returned.  The Calling procedure is further _
     responsible for the setting of the boolean field, which is based on _
     wheather there is ANY text in the "boolean" field, and what it is.

    Dim Idx As Integer
    Dim Jdx As Integer
    Dim blnFldMatch As Boolean
    Dim strCrit As String
    Dim Tmp As Variant
    Dim Quo As String * 1

    Quo = Chr(34)

    'This array is for the few "boolean" fields in [rstSrc] _
     which (unfortunatly) include text.  The Text (other than Y/N) _
     needs to be transfered to the Filed with the Name "FldsNew" & Desc _
     (e.g. the Text would go into [CirculatorPumpDesc] and the (boolean _
     field [CirculatorPump] is set to "Y" (true).
    Dim FldsNew(8) As String
    FldsNew(0) = "CirculatorPump"
    FldsNew(1) = "CirculatorRelays"
    FldsNew(2) = "EletricalWiring"
    FldsNew(3) = "HotWaterHeaterTankAndCoil"
    FldsNew(4) = "PressureReliefValves"
    FldsNew(5) = "PurgingValve"
    FldsNew(6) = "ZoneDampers"
    FldsNew(7) = "ZoneMotors"
    FldsNew(8) = "ZoneValve"

    Jdx = 0
    Do While Jdx <= UBound(FldsNew)

        If (MyFld) = FldsNew(Idx) Then
            blnFldMatch = True
            Exit Do
        End If

        Jdx = Jdx + 1

    Loop

    strCrit = "Company = " & Quo & MyCpny & Quo & " and " & "ServicePlan = " & Quo & MyPln & Quo
    rstSrc.FindFirst strCrit

    If (rstSrc.NoMatch) Then
        'Error. Just Bail
        GoTo ErrExit
    End If

    If (Jdx > UBound(FldsNew)) Then
        'No match to the bad boys, set return and exit
        Tmp = rstSrc(MyFld)
        GoTo NormExit
    End If

    'Here because there IS a match
    If (IsNull(rstSrc(MyFld))) Then
        Tmp = Null
        GoTo NormExit
    End If

    If (IsMissing(rstSrc(MyFld))) Then
        Tmp = Null
        GoTo NormExit
    End If

    If (Len(rstSrc(MyFld)) > 0) Then
        Tmp = Trim(rstSrc(MyFld))
        GoTo NormExit
    End If

NormExit:

    If (IsEmpty(Tmp)) Then
        Tmp = rstSrc(MyFld)
    End If

    basChkBlnContent = Tmp

ErrExit:
    Exit Function

End Function

MichaelRed

 

[TheAceMan1]

How are ya KornGeek . . . .

Not a bad idea except for two things:
[ol][li][blue]KevDBF[/blue] wants to store the data in a table.[/li]
[li]

[blue]I have a table with [purple]59,000 records [/purple]of unique data.[/blue]

[/li][/ol]
This translates into [purple]58,999[/purple] unions! . . . [blue]Ya Think! . . . [/blue]

See Ya! . . . . . .

 

[TheAceMan1]

KevDBF . . .

I've worked up code myself but waiting for you to answer my prior post . . . [purple]are the 57 fields of the same data type or not?[/purple] . . . this is a prime question that needs to be answered no matter what code is presented . . . Think about it? . . .

[blue]Your Thoughts? . . .[/blue]

See Ya! . . . . . .

 

[KornGeek]

TheAceMan1,

Actually, since what you're doing is extracting the 57 fields and combining them into a single field repeated as 57 new records (for each of the original 59000 records), wouldn't it be a single Union query with 56 Unions in it?

You could then run a make-table based on this union query (or potentially even leave it as a query).

It's quite possible that I'm missing something, but that seems like the easiest solution to me.

 

[TheAceMan1]

KornGeek . . .

I'm not trying to sound demeaning or anything like that, but are you saying you have no problem sitting down and writing [blue]59K unions! . . .[/blue]

See Ya! . . . . . .

 

[KevDBF]

Hi All

Thanks for all the postings - really appreciate the help!

The AceMan1 - All the fields are text so no worries about formats and conversions

Things are cool except this slight headache -

 

[TheAceMan1]

Roger That KevDBF . . . We are almost there!

The Idea is to populate a new table (no matter what)! . . . but your only problem is identifying the fields to be appended, and if this is done an additional form where you can tag those fields of interest is in order!

[blue]Your Thoughts . . .[/blue]

See Ya! . . . . . .

 

[KornGeek]

TheAceMan1,

There seems to be a Communication Breakdown here. I'm saying it could be done with 56 unions, not 59k. The structure would be similar to this (quoted from other thread):

Sounds like a union query would work.



Select Yourtable.SiteNumber, "Aug06" as Period, YourTable.Aug06 as Value from YourTable;

Union

Select Yourtable.SiteNumber, "Sep06" as Period, YourTable.Aug06 as Value from YourTable;

but instead would be more like

SELECT YourTable.ID, "Field1" as FieldName, YourTable.Field1 as DataValue from YourTable

UNION

SELECT YourTable.ID, "Field2" as FieldName, YourTable.Field2 as DataValue from YourTable, ...;

Thus, there is a select statement for each field, and 56 UNIONS. Not 59k. (The query would still take a long time to run however.)

Hopefully this clears things up.