I'm developing a vba routine that imports data from one table in Access into a recordset, manipulates the data, and exports the new data to a different table, but I don't know how to accomplish the last step.
Please see current code below. My thought is that the recordset will be sent to a new table (created earlier in the routine) almost at the end of the code (a couple of lines before the End Sub). The data in the "opt" array is what I need to send to the new table. Thanks in advance!!!
Option Compare Database
Public Sub test()
Dim dbs As Database
Dim maxquantifier, optquantifier, availquantifier, itemsize
Dim opt(70264, 2), item(610), ccount(610), temp(1 To 1, 1 To 4) As Double
Dim numrecs, count, count2, count3, count4 As Long
Dim misc As String
Dim quantifier, diff As Double
Dim tdf As TableDef
Set dbs = CurrentDb
Set tdf = dbs.CreateTableDef("NewResults"
With tdf
.Fields.Append .CreateField("Item", dbDouble)
.Fields.Append .CreateField("Item2", dbDouble)
.Fields.Append .CreateField("Quantifier", dbDouble)
.Fields.Append .CreateField("Margin", dbDouble)
dbs.TableDefs.Append tdf
End With
Set maxquantifier = dbs.OpenRecordset("ORQ"
If Not maxquantifier.BOF And Not maxquantifier.EOF Then
'get the number of records in the recordset need to movelast and move first to populate this property
maxquantifier.MoveLast
maxquantifier.MoveFirst
numrecs = maxquantifier.RecordCount
recarray = maxquantifier.GetRows(numrecs)
End If
maxquantifier.Close
Set availquantifier = dbs.OpenRecordset("sct"
If Not availquantifier.BOF And Not availquantifier.EOF Then
'get the number of records in the recordset need to movelast and move first to populate this property
availquantifier.MoveLast
availquantifier.MoveFirst
numrecs = availquantifier.RecordCount
'use "GetRows" method to assign to an array
recarray2 = availquantifier.GetRows(numrecs)
End If
availquantifier.Close
Set itemsize = dbs.OpenRecordset("ItemTotalQuantifier"
If Not itemsize.BOF And Not itemsize.EOF Then
'get the number of records in the recordset need to movelast and move first to populate this property
itemsize.MoveLast
itemsize.MoveFirst
numrecs = itemsize.RecordCount
'use "GetRows" method to assign to an array
recarray3 = itemsize.GetRows(numrecs)
End If
itemsize.Close
'recarray = optimizedresults table
'recarray2 = available quantifiers table
'recarray3 = item total quantifiers data
count = 0
For count = 0 To 610
ccount(count) = recarray3(2, count)
Next count
'The following loop populates the item array with item #
count = 0
For count = 0 To 610
item(count) = recarray3(0, count)
Next count
'The following loop populates the opt array with item #, linear quantifier, and diff
count = 0
For count = 0 To 69653
opt(count, 0) = recarray(0, count)
opt(count, 1) = recarray(1, count)
opt(count, 2) = recarray(2, count)
Next count
count = 0
count2 = 0
count3 = 0
quantifier = 0
'The following loop steps through each Item2 by item for current quantifier,
'avail. quantifier, min diff loss, etc. to populate each item with optimum
'quantifiers based on diff by item2 data
For count = 0 To 610
For count2 = 0 To ccount(count)
If item(count) = opt(count2, 0) Then 'matches item
quantifier = quantifier + opt(count2, 2)
End If
Next count2
Do While quantifier > recarray3(1, count)
diff = 1000000
For count3 = 0 To ccount(count)
For count4 = 0 To 2795
If recarray2(0, count4) = opt(count3, 1) Then 'matches Item2 #
If recarray2(1, count4) = opt(count3, 2) And count4 > 1 Then 'matches quantifier
If (diff > recarray2(3, count4) - recarray2(3, count4 - 1)) And recarray2(0, count4 - 1) = _
opt(count3, 1) Then
diff = recarray2(3, count4) - recarray2(3, count4 - 1)
temp(1, 1) = recarray2(0, count4 - 1)
temp(1, 2) = recarray2(1, count4 - 1)
temp(1, 3) = recarray2(3, count4 - 1)
temp(1, 4) = count3
End If
End If
End If
Next count4
Next count3
opt(temp(1, 4), 2) = temp(1, 2)
quantifier = 0
For count2 = 0 To ccount(count)
If item(count) = opt(count2, 0) Then 'matches item
quantifier = quantifier + opt(count2, 2)
End If
Next count2
Loop
Next count
Ok, I used the code you suggested, but am getting an error message:
Syntax error in INSERT INTO statement
Looks like the code you provided is exactly what I need, but may be missing a punctuation element (or something). Any additional suggestions? Thanks for you time and assistance!
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.