Transform records list into different table

[Marcster]

Hi People,

I have the following example data in a table named Table1:


Header

Data

AD

DN



A

E01

18/11/15

SG-000006



L

High

18/11/15

SG-000006



P

JB

18/11/15

SG-000006



D

18/11/15

18/11/15

SG-000006



A

E02 and E03

18/11/15

SG-000006



L

Medium

18/11/15

SG-000006



P

JB

18/11/15

SG-000006



D

27/11/15

18/11/15

SG-000006



A

water

18/11/15

SG-000006



L

Low

18/11/15

SG-000006



P

JB

18/11/15

SG-000006



D

30/12/15

18/11/15

SG-000006



A

A.11

18/11/15

SG-000006



L

Low

18/11/15

SG-000006



P

JB

18/11/15

SG-000006



D

30/11/15

18/11/15

SG-000006





That I need transforming into Table2:


A

L

P

D

DN

AD



E01

High

JB

18/11/15

SG-000006

18/11/15



E02 and E03

Medium

JB

27/11/15

SG-000006

18/11/15



water

Low

JB

30/12/15

SG-000006

18/11/15



A.11

Low

JB

30/11/15

SG-000006

18/11/15




Table1 Header column has the first 4 columns for Table2.
Each 4 rows in Table1 transpose to 1 row in Table2.

Any ideas?...

[jonh]

I added a new numeric field called grp to table1 to bind the records together ...
e.g. first 4 records = group 1, 2nd 4 = 2, etc.


Private Sub Command0_Click()
Const td As String = "table1"
Const newtd As String = "table2"

Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = DBEngine(0)(0)

If Not DelTDef(db, newtd) Then
MsgBox "Close table '" & newtd & "' and try again."
Exit Sub
End If

db.Execute "SELECT distinct a.grp, a.AD, a.DN,'' as A,'' as L,'' as P,#1/1/1901# as D INTO " & newtd & " FROM " & td & " as a"

With db.OpenRecordset("select grp,header,data from " & td)
Do Until .EOF
db.Execute "update " & newtd & " set " & .Fields(1) & "='" & .Fields(2) & "' where grp=" & .Fields(0)
.MoveNext
Loop
.Close
End With

RefreshDatabaseWindow
End Sub

Private Function DelTDef(db As DAO.Database, td As String) As Boolean
On Error Resume Next
db.TableDefs.Refresh
db.TableDefs.Delete td
Select Case Err.Number
Case 0, 3265: DelTDef = True
End Select
End Function




grp AD DN A L P D
1 18/11/2015 SG-000006 E01 High JB 18/11/2015
2 18/11/2015 SG-000006 E02 and E03 Medium JB 27/11/2015
3 18/11/2015 SG-000006 water Low JB 30/12/2015
4 18/11/2015 SG-000006 A.11 Low JB 30/11/2015

[Marcster]

Hi jonh,

Thanks for this :).

But when I run it I get the following run-time error:
Data type mismatch in criteria expression
on the line
db.Execute "update " & newtd & " set " & .Fields(1) & "='" & .Fields(2) & "' where grp=" & .Fields(0)

I have Table1 set as:
Header (Short Text)
Data (Short Text)
AD (Short Text)
DN (Short Text)
grp (short Text)

and Table2 as
grp (Short Text)
AD (Short Text)
DN (Short Text)
A (Short Text)
L (Short Text)
P (Short Text)
D (Short Text)

[jonh]

Oh, I thought D was date.
Either change it to date in t1 or change the line
db.Execute "SELECT distinct a.grp, a.AD, a.DN,'' as A,'' as L,'' as P,#1/1/1901# as D INTO " & newtd & " FROM " & td & " as a"

to


db.Execute "SELECT distinct a.grp, a.AD, a.DN,'' as A,'' as L,'' as P,'' as D INTO " & newtd & " FROM " & td & " as a"

[jonh]

Actually that make no sense. Sorry. Just change the sql.

[jonh]

And btw. The datatypes for table2 make no difference since my code will delete it and recreate it.

[Marcster]

Hi Jonh,

I must be doing something silly, I have attached a sample database as still get same error.

Also, do you have the code I can run that will populate the grp field?.

Thanks,14910

[jonh]

Change the grp field to a long int in table1.

How does the data get populated?

[Marcster]

Hi jonh,

Yep, your code now works, thanks :-)

It's a .csv file whereby the whole file is imported to a temp table and I run the following SQL to get the specific data:



SELECT temp.*
FROM temp
WHERE (((temp.Field3)="A")) OR (((temp.Field3)="L")) OR (((temp.Field3)="P")) OR (((temp.Field3)="D"));

[jonh]

Private Sub addgrp()


Dim a(), b(), s
Dim i, j

Const td As String = "table1" '<--- Change as necessary


a = Array("A", "L", "D", "P")
ReDim b(UBound(a))

For j = 0 To UBound(a)
With DBEngine(0)(0).OpenRecordset("select grp from " & td & " where header='" & a(j) & "'")
Do Until .EOF
i = i + 1
.Edit
.Fields(0).Value = i
.Update
.MoveNext
Loop
.close
End With
b(j) = i
i = 0
Next

'validation...

'check if number of records match for each header
For i = 0 To UBound(b) - 1
If b(i) <> b(i + 1) Then
MsgBox "number of " & a(i) & " (" & b(i) & _
") does not match number of " & a(i + 1) & " (" & b(i + 1) & ")", _
vbExclamation, "Data Error"
Exit Sub
End If
Next

End Sub