Hi all
Any thoughts to this problem I am having within a VBA code please?
The code is basically in 3 parts.
First stage gets user inputs such as a week number for the date range.
secondly, there is are a couple of external database connections to SAP to retrieve the data based on the user criteria. This data is brought into a couple of tables where a couple of lookups sit to link data together. The final data tables are then sorted by date and resource criteria.
Finally, the data is read from the tables into a new sheet and formatted accordingly.
Now here's the wierdness!
If I run the procedure it fails to read the data from the tables into the new sheet, until I run it a second time. However if i step through the procedures, it runs fine.
At the moment I have broken the macro into 2 subs with button one runs steps 1 & 2 and button 3 runs step 3.
I have tried calling the step 3 sub after step 2, but still not working.
I have tried a pause code in the routine, I have tried an refresh all.
Any thoughts please
Thanks in advance - John
Apologies for any bad coding...
Any thoughts to this problem I am having within a VBA code please?
The code is basically in 3 parts.
First stage gets user inputs such as a week number for the date range.
secondly, there is are a couple of external database connections to SAP to retrieve the data based on the user criteria. This data is brought into a couple of tables where a couple of lookups sit to link data together. The final data tables are then sorted by date and resource criteria.
Finally, the data is read from the tables into a new sheet and formatted accordingly.
Now here's the wierdness!
If I run the procedure it fails to read the data from the tables into the new sheet, until I run it a second time. However if i step through the procedures, it runs fine.
At the moment I have broken the macro into 2 subs with button one runs steps 1 & 2 and button 3 runs step 3.
I have tried calling the step 3 sub after step 2, but still not working.
I have tried a pause code in the routine, I have tried an refresh all.
Any thoughts please
Thanks in advance - John
Apologies for any bad coding...
Code:
Public Sub Launch()
Dim lsNewWeekNumber As String
Dim StartDate As Date
Dim EndDate As Date
Dim StartDate1 As Long
Dim EndDate1 As String
Dim tbl As ListObject
Dim SchedArray As Variant
Dim x As Long
Dim lwsScratch As Worksheet
Dim ldtStartDate As Date ' Order Due date
Dim wbkReference As Workbook
Dim lsLine As String ' Production line code
Dim lsInputLine As String ' A Line from the data file
Dim lsProductCode As String ' Product code of current run
Dim lnMins As Variant ' Run length in Minutes
Dim lsProductName As String ' Product name at start of run
Dim lnQuantity As Variant ' Quantity produced (Cases) may be null if size change
Dim lsOrderNum As String ' Product code of current run
Dim lsDayOfWeek As String
On Error Resume Next
If Err.Number <> 0 Then
Exit Sub
End If
On Error GoTo 0
'Step one - get user week number input
Worksheets("Start").Range("WeekNumber").Value = Application.InputBox("Enter week number")
StartDate = Worksheets("Start").Range("StartDate").Value
EndDate = StartDate + 7
StartDate1 = Format(StartDate, "yyyymmdd")
EndDate1 = Format(EndDate, "yyyymmdd")
Set wbkReference = Me
'Fetch data from SAP
With ActiveWorkbook.Connections("Query from SAP_Live").ODBCConnection
.CommandText = "SELECT distinct T0.[DocNum], T0.[ItemCode], T0.[StartDate], T0.[PlannedQty], T1.[ItemCode], T1.[PlannedQty], T1.[ItemType] FROM OWOR T0 INNER JOIN WOR1 T1 ON T0.[DocEntry] = T1.[DocEntry] WHERE T1.[ItemType] >= 290 AND (T0.[Status] ='P' OR T0.[Status] ='R') and (T0.[DueDate] >= '" & StartDate1 & "' And T0.[DueDate] < '" & EndDate1 & "') "
ActiveWorkbook.Connections("Query from SAP_Live").Refresh
End With
With ActiveWorkbook.Connections("Query from SAP_Live2").ODBCConnection
.CommandText = "SELECT T0.[ItemCode], T0.[ItemName],T0.[U_TECMilk], T0.[U_TECGulten], T0.[U_TECSoya], T0.[U_TECFish], T0.[U_TECEgg], T0.[U_TECSO2], T0.[U_TECNOAL], T0.[U_TECPork] FROM OITM T0 WHERE T0.[ItmsGrpCod] = 105 and T0.[validFor] =('Y')"
ActiveWorkbook.Connections("Query from SAP_Live2").Refresh
End With
'Sort data
ActiveWorkbook.Worksheets("Production_Order").ListObjects("Item_Master_Table"). _
Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Production_Order").ListObjects("Item_Master_Table"). _
Sort.SortFields.Add Key:=Range("Item_Master_Table[Sequence]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Production_Order").ListObjects("Item_Master_Table"). _
Sort.SortFields.Add Key:=Range("Item_Master_Table[StartDate]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Production_Order").ListObjects( _
"Item_Master_Table").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Call Populate
End Sub
Public Sub Populate()
Dim wbkReference As Workbook
Dim lwsScratch As Worksheet
Dim lsLine As String ' Production line code
Dim lsInputLine As String ' A Line from the data file
Dim lsProductCode As String ' Product code of current run
Dim lnMins As Variant ' Run length in Minutes
Dim lsProductName As String ' Product name at start of run
Dim lnQuantity As Variant ' Quantity produced (Cases) may be null if size change
Dim lsOrderNum As String ' Product code of current run
Dim lsDayOfWeek As String
Dim lsAllergens As String
Set wbkReference = Me
Set lwsScratch = wbkReference.Worksheets("Scratch")
'Read data into Worksheet named Scratch
wbkReference.Worksheets("Scratch").Cells.Delete
Set tbl = wbkReference.Worksheets("Production_Order").ListObjects("Item_Master_Table")
SchedArray = tbl.DataBodyRange
With wbkReference.Worksheets("Scratch")
.Cells(1, 1).Value = "Unit"
.Cells(1, 2).Value = "Order Number"
.Cells(1, 3).Value = "SKU Code"
.Cells(1, 4).Value = "SKU Description"
.Cells(1, 5).Value = "Allergens"
.Cells(1, 6).Value = "Order Date"
.Cells(1, 7).Value = "Day of Week"
.Cells(1, 8).Value = "Run Length (Hrs:Min)"
.Cells(1, 9).Value = "Quantity"
End With
y = 2
For x = LBound(SchedArray) + 1 To UBound(SchedArray)
If tbl.Range(x, 8).Value = "" Then
Else
lsProductCode = tbl.Range(x, 1).Value
lsOrderNum = tbl.Range(x, 2).Value
lnQuantity = tbl.Range(x, 3).Value
ldtStartDate = tbl.Range(x, 7).Value
lnMins = tbl.Range(x, 6).Value
lsLine = tbl.Range(x, 8).Value
lsProductName = tbl.Range(x, 9).Value
lsDayOfWeek = tbl.Range(x, 10).Value
lsAllergens = tbl.Range(x, 12).Value
With wbkReference.Worksheets("Scratch")
.Cells(y, 1) = lsLine
.Cells(y, 2) = lsOrderNum
.Cells(y, 4) = lsProductCode ' Product Code
.Cells(y, 5) = lsProductName
.Cells(y, 8) = lsAllergens
.Cells(y, 7) = ldtStartDate
.Cells(y, 7) = lsDayOfWeek
.Cells(y, 8) = lnMins / 1444 ' duration mins
.Cells(y, 8).NumberFormat = "hh:mm"
.Cells(y, 9) = lnQuantity
End With
y = y + 1
End If
Next x
wbkReference.Worksheets("Scratch").Range("A:H").EntireColumn.AutoFit
Worksheets("Scratch").Select
End Sub
