Transpose From Horizontal to vertical format (1 Viewer)

[VBA_Lover]

hi, i have a problem to transpose from horizontal table to vertical table

here is TempTable

04-00-OPU_DetailsID	Code	RateCategory	EqType	Desc	Spec	01/07/2021	02/07/2021	03/07/2021	04/07/2021	05/07/2021
10	ECT0045	12	T8A	Mobile Crane with Operator & signalman	45T	3	2	4	4	4

what should i do if i want to insert the data to table [01-01-TotalManPowerQty] ( in vertical format )

04-00-OPU_DetailsID	Code	RateCategory	EqType	Desc	Spec	DateTAManpower	TotalManPowerQty
10	ECT0045	12	T8A	Mobile Crane with Operator & signalman	45T	01/07/2021	3​
11	ECT0046	13	T8A	Mobile Crane with Operator & signalman	45T	02/07/2021	2​
12	ECT0047	14	T8A	Mobile Crane with Operator & signalman	45T	03/07/2021	4​
13	ECT0048	15	T8A	Mobile Crane with Operator & signalman	45T	04/07/2021	4​
14	ECT0049	16	T8A	Mobile Crane with Operator & signalman	45T	05/07/2021	4​

 

[ebs17]

In Excel, Power Query has a very simple UNPIVOT functionality.

Alternatively, you can try something like this:

Public Function PivotToList(ByVal NamePivotTable As String, _
                            ByVal NameListTable As String, _
                            ByVal NumberFirstMatrixField As Byte, _
                            ByVal NameTitleField As String, _
                            ByVal NameValueField As String, _
                            ByVal TypeValuefield As DataTypeEnum, _
                            Optional ByVal UseNullValues As Boolean = False, _
                            Optional ByVal IntoNewTable As Boolean = False) As Boolean
    On Error GoTo ErrHandler
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim sSQL As String
    Dim sConstantFields As String
    Dim bExistsTable As Boolean
    Dim i As Long

    Set dbs = CurrentDb

    bExistsTable = TableExistsDAO(dbs, NameListTable)
    If IntoNewTable Then
        If bExistsTable Then dbs.TableDefs.Delete NameListTable
    End If

    Set rst = dbs.OpenRecordset(NamePivotTable, dbOpenSnapshot)
    With rst
        If Not bExistsTable Or IntoNewTable Then
            ' Listtabelle neu erstellen
            Set tdf = dbs.CreateTableDef(NameListTable)
            For i = 0 To NumberFirstMatrixField - 2
                Set fld = tdf.CreateField(.Fields(i).Name, .Fields(i).Type)
                tdf.Fields.Append fld
                sConstantFields = sConstantFields & "[" & .Fields(i).Name & "], "
            Next
            Set fld = tdf.CreateField(NameTitleField, dbText)
            tdf.Fields.Append fld
            Set fld = tdf.CreateField(NameValueField, TypeValuefield)
            tdf.Fields.Append fld
            dbs.TableDefs.Append tdf
            RefreshDatabaseWindow
        End If

        ' Inhalte übertragen
        sConstantFields = ""
        For i = 0 To NumberFirstMatrixField - 2
            sConstantFields = sConstantFields & "[" & .Fields(i).Name & "], "
        Next
        For i = NumberFirstMatrixField - 1 To .Fields.Count - 1

            sSQL = "INSERT INTO " & NameListTable & " (" & sConstantFields & "[" & _
                   NameTitleField & "], [" & NameValueField & "])" & _
                   " SELECT " & sConstantFields & "'" & .Fields(i).Name & "', [" & _
                   .Fields(i).Name & "] FROM " & NamePivotTable
            If Not UseNullValues Then
                sSQL = sSQL & " WHERE [" & .Fields(i).Name & "] IS NOT NULL"
            End If
            dbs.Execute sSQL, dbFailOnError
        Next

        .Close
    End With

    '    ' Beispiel für ein Setzen eines zusammengesetzten Index
    '    sSQL = "CREATE INDEX NachnameVorname ON Listtabelle(Nachname, Vorname)"
    '    dbs.Execute sSQL, dbFailOnError

    Set rst = Nothing
    Set dbs = Nothing

    PivotToList = True

Exit_Function:
    Exit Function
ErrHandler:
    MsgBox "Fehler: " & vbTab & Err.Number & vbCrLf & Err.Description
    Resume Exit_Function
End Function

Public Function TableExistsDAO(pDb As DAO.Database, _
                               ByVal psName As String) As Boolean
    Dim s As String

    On Error Resume Next
    s = pDb.TableDefs(psName).Name
    TableExistsDAO = (Err.Number = 0)
End Function

 

[Pat Hartman]

Rather than saving the unpivot to a temp table, you can use a union query that a select for each column you want to convert to a row. Looks like 5 from the sample.

 

[June7]

UNION query can normalize data. There is a limit of 50 SELECT lines. First SELECT determines field names and data types. Incrementing a field is something I haven't tried before. Why do you want to? Was that intentional in your example?

SELECT [04-00-OPU_DetailsID], Code, RateCategory, EqType, [Desc] AS DetDesc, Spec, [01/07/2021] AS TotalManPowerQty, #1/7/2021# AS DateTAManpower FROM table
UNION SELECT [04-00-OPU_DetailsID] + 1, Left(Code,3) & Format(Right(Code, 4) + 1, "0000"), RateCategory + 1, EqType, Desc, Spec, [02/07/2021], #2/7/2021# FROM table
UNION SELECT [04-00-OPU_DetailsID] + 2, Left(Code,3) & Format(Right(Code, 4) + 2, "0000"), RateCategory + 2, EqType, Desc, Spec, [03/07/2021], #3/7/2021# FROM table
UNION SELECT [04-00-OPU_DetailsID] + 3, Left(Code,3) & Format(Right(Code, 4) + 3, "0000"), RateCategory + 3, EqType, Desc, Spec, [04/07/2021], #4/7/2021# FROM table
UNION SELECT [04-00-OPU_DetailsID] + 4, Left(Code,3) & Format(Right(Code, 4) + 4, "0000"), RateCategory + 4, EqType, Desc, Spec, [05/07/2021], #5/7/2021# FROM table;

Desc is a reserved word. Suggest not using reserved words as field names. Also advise not to use spaces nor punctuation/special characters in naming convention.

You appear to be creating tables for each month as indicated by table name 01-01-TotalManPowerQty. That is usually a bad design.

 

[arnelgp]

i don't know how you are Able to create a Table with dash "-" on your fieldname.
my Access 2021 won't allow me to create such.

 

[June7]

Access 2010 has no problem using hyphen. Something changed?

 

[arnelgp]

 

[ebs17]

Rather than saving the unpivot to a temp table, you can use a union query

These are then written each time by hand, because column names and number change, and this corresponds to the always applied self-promised efficiency?

 

[isladogs]

Access365 v2302
Although i wouldn't ever do so myself, you can definitely start object and field names with numbers and use hyphens
You are also use many special characters (though not ! or .)
Very bad practice but definitely possible

Must be an issue in your installation

 

[arnelgp]

After Replacing my A2016 with A2021 it now works ok.

 

[arnelgp]

to the OP:

Public Function fnTranspose()

    Const SOURCE_TABLE As String = "TempTable"
    Const TARGET_TABLE As String = "01-01-TotalManPowerQty"
    
    Dim DB As DAO.Database
    Dim RS As DAO.Recordset
    Dim fd As DAO.Field
    Dim arr() As Date
    Dim var As Variant
    Dim i As Integer
    Set DB = CurrentDb
    Set RS = DB.OpenRecordset(TARGET_TABLE, dbOpenDynaset)
    With DB.OpenRecordset(SOURCE_TABLE, dbOpenSnapshot, dbReadOnly)
        If Not (.BOF And .EOF) Then
            .MoveFirst
        End If
        Do Until .EOF
            ' get all date fields
            ReDim arr(1 To 255): i = 0
            For Each fld In .Fields
                With fld
                    If IsDate(.Name) Then
                        var = Split(.Name, "/")
                        ' convert to US-EN date format
                        i = i + 1
                        arr(i) = DateSerial(var(2), var(1), var(0))
                    End If
                End With
            Next
            ReDim Preserve arr(1 To i)
            For i = 1 To UBound(arr)
                ' check if this record already exists
                RS.FindNext "Code='" & !Code & "' And Spec='" & !Spec & "' And DateTAManpower=#" & Format(arr(i), "yyyy-mm-dd") & "#"
                If RS.NoMatch Then
                    RS.AddNew
                    RS![04-00-OPU_DetailsID] = ![04-00-OPU_DetailsID] + i - 1
                    RS![Code] = ![Code]
                    RS![RateCategory] = ![RateCategory] + i - 1
                    RS![EqType] = ![EqType]
                    RS![Desc] = ![Desc]
                    RS![Spec] = ![Spec]
                    RS![DateTAManpower] = arr(i)
                    RS![TotalManpowerQty] = .Fields(Format$(arr(i), "dd/mm/yyyy"))
                    RS.Update
                End If
            Next i
            .MoveNext
        Loop
        .Close
    End With
    RS.Close
    Set RS = Nothing
    Set DB = Nothing
End Function

open Form1 on the demo database and press the "Transpose" button.

 

[Pat Hartman]

These are then written each time by hand, because column names and number change, and this corresponds to the always applied self-promised efficiency?

You CAN build the crosstab using VBA.
OR
You can have the temp table in a separate database that you can just delete and recreate to avoid bloat in either the FE or BE.