MS Access 2010 vba query

Question

OVERVIEW

I am attempting to break down or decompose a assembly list. We are starting with an input table generated by a design program. The format is fixed.

I am attempting to breakdown each assembly in the comment columns to a new table with the structure number associated with said assembly.

I was going to create a query, selecting all 50 columns as the input for the new table, but I found some VBA code on the 'net that would create the query dynamically based on the column names.

The code seemed to work, but all it ended up doing was taking the assembly items from the first structure number and repeating them on the rest of the structure numbers.

I am so close...but still so far away from a solution - so if anyone has any ideas as to how to correct my query, I'm all ears.

Thanks in advance.

M.

INPUT TABLE SAMPLE DATA

    StructureNumber Structure  Comment  2   Structure  Comment  3   Structure  Comment  4   Structure  Comment  5   Structure  Comment  6   Structure  Comment  7   Structure  Comment  8   Structure  Comment  9   Structure  Comment  10
26  1-S80-H2    1-TS-15PG   1-TMF-CB    1-TM-124TDS 1-TM-9D(22) 1-TM-103    22-TG-1G    11-TG-21C   11-TA-5L
27  1-S90-H4*   1-TBP-161A  1-C9-3A(12) 1-TMF-4B    1-TM-9D(2)  1-TM-101    2-TG-1G 1-TG-21C    1-TA-5L
28  1-S90-H5*   1-TBP-161A  1-C9-3A(12) 1-TMF-4B    1-TM-9D 1-TM-101    2-OPT-D 1-TM-N  * BURY 12.5 FT
29  2-S105-H1*  1-TH-10PV4XX-SP 1-C9-3A(12)D    1-TMF-4B    1-TM-9F 2-TM-101    1-OPT-D 1-OPT-2D    1-TM-N
30  3-S90-H2    1-TH-15PDX  1-TMF-112T  1-TM-9L 3-TM-101    1-OPT-D 1-OPT-2D    1-TM-N  

OUTPUT TABLE SAMPLE

ID  StrNum  Assembly    Qty
22033   26  S80-H2  1.00
22067   26  TS-15PG 1.00
22101   26  TMF-CB  1.00
22135   26  TM-124TDS   1.00
22169   26  TM-9D(22)   1.00
22203   26  TM-103  1.00
22237   26  TG-1G   22.00
22271   26  TG-21C  11.00
22305   26  TA-5L   11.00
22339   26  OPT-D   1.00
22373   26  TM-N    1.00
22034   27  S80-H2  1.00
22068   27  TS-15PG 1.00
22102   27  TMF-CB  1.00
22136   27  TM-124TDS   1.00
22170   27  TM-9D(22)   1.00
22204   27  TM-103  1.00
22238   27  TG-1G   22.00
22272   27  TG-21C  11.00
22306   27  TA-5L   11.00
22340   27  OPT-D   1.00
22374   27  TM-N    1.00
22035   28  S80-H2  1.00
22069   28  TS-15PG 1.00
22103   28  TMF-CB  1.00
22137   28  TM-124TDS   1.00
22171   28  TM-9D(22)   1.00
22205   28  TM-103  1.00
22239   28  TG-1G   22.00
22273   28  TG-21C  11.00
22307   28  TA-5L   11.00
22341   28  OPT-D   1.00
22375   28  TM-N    1.00

VBA CODE

Option Compare Database

Function TransposeTable()
Dim rsMySet As DAO.Recordset
Dim strSQL As String
Dim OutputTable As String
Dim InputTable As String

Dim i As Integer

InputTable = "MatrixDataset"
OutputTable = "TabularDataset"

'Open the original matrix-style dataset
Set rsMySet = CurrentDb.OpenRecordset(InputTable)

'Start the count at the position number of the first column-oriented field
'Remember that Recordsets start at 0
'For j = 1 To rsMySet.RecordCount - 1
For i = 1 To rsMySet.Fields.Count - 1

'Use the recordset field.name property to build out the SQL string for the current field

strSQL = "INSERT INTO TabularDataset ([StrNum],[Assembly]) " & _
"SELECT [MatrixDataset].[StructureNumber] as StrNum," & _
"'" & rsMySet.Fields(i).Value & "'" & " AS Assembly " & "FROM MatrixDataset WHERE " & _
"'" & rsMySet.Fields(i).Value & "'" & " <> '';"

'Execute the SQL string

CurrentDb.Execute strSQL

'Move to the next column-oriented field

Next i


' Now we need to update the assembly to pull the quantity from
' the front of the field and place it in the Qty field

' UPDATE OutputTable SET Qty = left(Assy,instr(Assy,"-"-1))
strSQL = "UPDATE " & "`" & OutputTable & "` as ot" & " SET ot.Qty = left(ot.Assembly,instr(ot.Assembly,'-')-1);"
CurrentDb.Execute strSQL

strSQL = "UPDATE " & "`" & OutputTable & "` as ot" & " SET ot.Assembly = right(ot.Assembly,len(ot.Assembly)-instr(ot.Assembly,'-'));"
CurrentDb.Execute strSQL

'strSQL = "SELECT Assembly, Qty FROM `" & OutputTable & "` GROUP BY Assembly ORDER BY Assembly;"
'CurrentDb.Execute strSQL

End Function

Answer 1

Try something like this, have no Access near my hands so syntax problems can be met, and using ADO instead of DAO

Option Compare Database

Sub TransposeTable()
Dim Conn as ADODB.Connection
Dim tblInput As ADODB.Recordset
Dim OutputTable As String
Dim InputTable As String

Dim i As Integer
Dim StrNum As String
Dim Assembly As String
Dim Qty as Integer

InputTable = "MatrixDataset"
OutputTable = "TabularDataset"

set Conn = CurrentProject.Connection
Conn.Execute "create table " &    OutputTable & _
             " ( StrNum Text(20), Assembly Text(100), Qty Long) "

set tblInput = new ADODB.Recordset
tblInput.Open InputTable

do while not tblInput.EOF
    StrNum = tblInput(0)
    For i = 1 To tblInput.Fields.Count - 1
        Assembly = Right( tblInput(i), Len(tblInput(i)) - instr(tblInput(i), "-"))
        Qty = CInt(Left( tblInput(i), instr(tblInput(i), "-") - 1))
        Conn.Execute "insert " & OutputTable & "(StrNum, Assembly, Qty)" & _
         " values ('" & StrNum &"', '" & Assemby & "', " & CStr(Qty) & ")"
    Next i
    tblInput.MoveNext
loop 


tblInput.Close
set tblInput = Nothing

End Sub

Answer 2

Here is a slightly different approach that will yield your desired results. Note that the input value "1-TM-N * BURY 12.5 FT" may require some cleansing if you do not want the " * BURY 12.5 FT" in the result

Sub BuildOutputTable()
Dim db As DAO.Database
Set db = CurrentDb
Dim rsInp As DAO.Recordset
Set rsInp = db.OpenRecordset("SELECT * FROM inpdata")
Dim rsOut As DAO.Recordset
Set rsOut = db.OpenRecordset("SELECT * FROM outdata")

Do Until rsInp.EOF
  rsOut.AddNew
  For i = 1 To rsInp.Fields.Count - 1
    rsOut.AddNew
    rsOut!StrNum = rsInp.Fields(0).Value
    If Not IsNull(rsInp.Fields(i)) Then
        Dim FirstDashPos As Integer
        FirstDashPos = InStr(rsInp.Fields(i), "-")
        rsOut!Qty = Val(Left(rsInp.Fields(i), FirstDashPos))
        rsOut!Assembly = Right(rsInp.Fields(i), Len(rsInp.Fields(i)) - FirstDashPos)
    End If
    rsOut.Update
  Next
  rsInp.MoveNext
Loop

End Sub