VBA Access Code - Starting a new line in Excel export

[vbavir]

I am very new to this forum stuff

I have a VBA code which currently exports a set of 8 fields into Excel - the set consists of part number, quantity, total quantity, number of packs, pack quantity - for each dealer I only need a total of 8 sets - works great

However some dealers have less than 8 parts - some have more - also I need the Total weight for all the parts for each dealer not just the 8

I am currently using a query to retrive this infomation
I do have a table which contains the total weight for each dealer which I could use as the .find strcriteria but not sure how to work that piece of the puzzle

(did not know how to attach-code is below)

Public Sub ExportLicensePlate()


Dim objXLApp As New Excel.Application
Dim objXLBook As Excel.workbook
Dim objResultsSheet As Excel.Worksheet
Dim cdb As DAO.Database
Dim rst As DAO.Recordset
Dim rsHdr As Recordset, rsDet As Recordset

Dim fldPart As DAO.Field, fldTPks As DAO.Field
Dim fldQty As DAO.Field, fldWgt As DAO.Field
Dim fldPks As DAO.Field, fldDlr As DAO.Field
Dim fldLcs As DAO.Field

Dim ingTwgt As Integer
Dim strDlCd As String

'Dim strCriteria As String

Set cdb = CurrentDb
Set rst = cdb.OpenRecordset("qryLicensePlateNEWtest")
objXLApp.Visible = True
Set objXLBook = GetObject("I:\Labels\LicensePlateTemplate2.XLT")
Set objResultsSheet = objXLBook.Worksheets("qryLicensePlate")

'Set rsHdr = cdb.OpenRecordset("neworders")
'Set rsDet = cdb.OpenRecordset("newparts")
'strCriteria = "DEALERCODE " & " '" & rsHdr![DEALERCODE] & "'""" 'not sure where the " and ' need to go
'rsDet.FindFirst strCriteria

Dim intRowInd As Integer, intCount As Integer, introw As Integer

Set fldPart = rst.Fields("PartNo")
Set fldQty = rst.Fields("sumofQUANTITYSHIPPED")
Set fldDlCode = rst.Fields("DealerCode")
Set fldnopcks = rst.Fields("sumofTotalPacks")
Set fldpcks = rst.Fields("PackQty")
Set fldwght = rst.Fields("sumoftotalWeight")
Set fldlctplt = rst.Fields("LicenseNo")



'code will Transfer data from access to excel
'starting point is A2
intRowCount = 2

intRowInd = rst.RecordCount

' need to loop for each dealer - some dealers may have less the 8 pieces


If Not rst.BOF Then rst.MoveFirst
' strDlCd = rst.Fields("dealercode")

Do Until rst.EOF
objResultsSheet.Cells(intRowCount, "a") = fldDlCode
objResultsSheet.Cells(intRowCount, "I") = fldlctplt
intColumnCount = 10
intCount = 0
ingTwgt = 0

' If strDlCd <> rst.Fields("dealercode") Then 'loop to the next dealercode

' Do Until strDlCd = rst.Fields("dealercode")
' rst.MoveNext
' Loop
' Else

Do Until intCount = 8
ingTwgt = ingTwgt + fldwght
objResultsSheet.Cells(intRowCount, "H") = ingTwgt
objResultsSheet.Cells(intRowCount, intColumnCount) = fldPart
intColumnCount = intColumnCount + 1
objResultsSheet.Cells(intRowCount, intColumnCount) = fldQty
intColumnCount = intColumnCount + 1
objResultsSheet.Cells(intRowCount, intColumnCount) = fldQty
intColumnCount = intColumnCount + 1
objResultsSheet.Cells(intRowCount, intColumnCount) = fldnopcks
intColumnCount = intColumnCount + 1
objResultsSheet.Cells(intRowCount, intColumnCount) = fldpcks
intColumnCount = intColumnCount + 1

intCount = intCount + 1


rst.MoveNext

Loop

' End If



intRowCount = intRowCount + 1

Loop

 

[lameid]

Perhaps the layout of the tables and SQL behind qryLicensePlateNEWtest would help...

Also I see that you have at least one test involving strDlCd but you have the only line that would set it commented out.

Right now I'm not sure your code does anything because of this.

My first thought would have been to Loop until a Recordset.EOF for your items but I see you are doing that in a higher loop. Pehaps you could include a part number count for each dealer and loop until it instead of 8? Perhaps you should run with criteria for only one dealer and use that to get your part numbers?

Those are just the few things I can say without knowing anything about the data that the query is returning.