Skip Bisconer
Who Me?
- Local time
- Yesterday, 17:15
- Joined
- Jan 22, 2008
- Messages
- 285
I am using this to populate a spreadsheet but my data is way to large (10,000+ lines in 31 columns) to use this effectively. Help indicates transfering data in an array is the best way to go but I can't figure out from their example how set this data from a query into an array. Below is my code I am using now.
Code:
Function FillWSInvAnalLoc1()
' Direct procedure flow.
'On Error GoTo ErrorHandler
Dim objXL As Object
Dim xlWB As Object
Dim xlWS As Object
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set xlWB = objXL.Workbooks.Open("C:\Inventory\XLInventoryAnalysisLoc1.xlsm")
Set xlWS = xlWB.Worksheets("InvAnalysis")
'xlWB.Worksheets("InvAnalysis").Unprotect Password:=("1234")
Dim db As Database
Dim rs As Recordset
Dim i As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("qryInventoryAnalysisLoc1", , dbOpenDynamic)
rs.MoveFirst
i = 2
Do Until rs.EOF
With xlWS
' assign records to specific cells
.Range("A" & i).Value = rs.Fields("Part").Value
.Range("B" & i).Value = rs.Fields("Description").Value
.Range("C" & i).Value = rs.Fields("VCode").Value
.Range("D" & i).Value = rs.Fields("WhsLocation").Value
.Range("E" & i).Value = rs.Fields("VendorID").Value
.Range("F" & i).Value = rs.Fields("VendUOM").Value
.Range("G" & i).Value = rs.Fields("VendItemMinOrd").Value
.Range("H" & i).Value = rs.Fields("InventoryCost").Value
.Range("I" & i).Value = rs.Fields("InventoryList").Value
.Range("J" & i).Value = rs.Fields("QtyOnOrder").Value
.Range("K" & i).Value = rs.Fields("QtyOnBackOrder").Value
.Range("L" & i).Value = rs.Fields("QtyOnHand").Value
.Range("M" & i).Value = rs.Fields("QtyMin").Value
.Range("N" & i).Value = rs.Fields("QtyMax").Value
.Range("O" & i).Value = rs.Fields("AvgMo").Value
.Range("P" & i).Value = rs.Fields("ListMargin").Value
.Range("Q" & i).Value = rs.Fields("LeadTime").Value
.Range("R" & i).Value = rs.Fields("ReviewCycle").Value
.Range("S" & i).Value = rs.Fields("CarryCost").Value
.Range("T" & i).Value = rs.Fields("ReplenishmentCosts").Value
.Range("U" & i).Value = rs.Fields("SurplusStock").Value
.Range("V" & i).Value = rs.Fields("SA").Value
.Range("W" & i).Value = rs.Fields("SAPcnt").Value
.Range("X" & i).Value = rs.Fields("SP").Value
.Range("Y" & i).Value = rs.Fields("EOQ").Value
.Range("Z" & i).Value = rs.Fields("Calc1").Value
.Range("AA" & i).Value = rs.Fields("Calc2").Value
.Range("AB" & i).Value = rs.Fields("Calc3").Value
.Range("AC" & i).Value = rs.Fields("LP").Value
.Range("AD" & i).Value = rs.Fields("OP").Value
.Range("AE" & i).Value = rs.Fields("RecBuyQty").Value
End With
i = i + 1
rs.MoveNext
Loop
'Run Sheet 2 first
objXL.Application.Run "XLInventoryAnalysisLoc1.xlsm!FormatNewTable"
'xlWB.Worksheets("CurrentCharges").Protect Password:=("1234")
'objXL.activeworkbook.Save
'objXL.Application.Quit
'objXL.Application = Nothing
rs.Close
db.Close
Exit Function
End Function