VISHAL120
08-17-2020, 05:43 AM
Hello Everyone,
I hope everything is fine for you all.
I have been using this code below to load our factory . At first it was working quite well but after we started placing more orders to load its taking a lot of time to do the calculation almost 20-25 secs for every change we do which is very time consuming.
Sub Main_Normal_Calculation()
With Application
'.Cursor = xlWait
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim lLR As Long
Dim start_Time#, End_Time#
Sheets("Main").Activate
ActiveSheet.Unprotect
If ActiveSheet.AutoFilterMode _
Then Selection.AutoFilter
Call Remove_Format_On_Loading
'Call Order_Sequencing_Arrange
With ThisWorkbook.Sheets("Main")
lLR = Cells(Rows.Count, "H").End(xlUp).Row
End With
start_Time = Timer
Application.StatusBar = " Automate Calculation Started : Computing ...."
'reassigning the offset formula first due to add deletion rows.
Range("check_start_date_before_load").Select
Selection.Copy
Range("BJ12").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("CK10").Select
Application.CutCopyMode = False
With Range("CK12:IC" & lLR)
.Formula = "=IF(ISERROR(IF(CK$10<$BK12,0,IF(CK$10>=$BK12,IF(AND(CK$10=$BK12,$BE12<>""""),$BE12,IF(AND(CK$10=$BH12,$BF12<>""""),$BF12,IF(AND(CK$10=$BI12,$BG12<>""""),$BG12,IF(0<($AX12),MIN(($AX12-SUM($CJ12:CJ12)),$BS12)))))))),0,(IF(CK$10<$BK12,0,IF(CK$10>=$BK12,IF(AND(CK$10=$BK12,$BE12<>""""),$BE12,IF(AND(CK$10=$BH12,$BF12<>""""),$BF12,IF(AND(CK$10=$BI12,$BG12<>""""),$BG12,IF(0<($AX12),MIN(($AX12-SUM($CJ12:CJ12)),$BS12)))))))))"
.Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With
Call Build_Delivery_Assessment
Call Launching_Code
End_Time = Timer
Application.StatusBar = "Automated Planning Main Calculation Completed In " & Format(End_Time - start_Time, "0.000") & "secs"
Rows("10:10").Select
ActiveSheet.Unprotect
Selection.AutoFilter
Range("CK10").Select
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True
With Application
.Cursor = xlDefault
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = xlCalculationManual
End With
End Sub
The formula will derive the minimum quantity to plan daily based from column BS and also shall check the 1st , 2nd and 3rd day load. These 1st day, 2nd day and 3rd day load we normally give from every new styles starting on a particular line number which are from columns BE,BF,BG.
The 2nd day and 3rd day sometimes are optional and are based on the complexity of the style then we allocated if necessary the 2nd and 3rd day.
If also fetches the end date of the previous order from the grid where the calculation are done and cross checked with the block date given in column BC which after validates all in the column BK will start the next order for the particular line number. Please see the attached file to get a better idea of it .
I have place 2 buttons here on the rows 4,5,6 the first one is when click will calculate with the vba and the formula.
The formula is set to calculation automatic only when the formula is running due to several iterations that also are done for the calculation on the workbook. That is why I have set the calculation at start to manual and only calculate when the code is executed. I have also converted the formula to values after the calculation so that it does not go bigger in size as the planning itself has around 800-900 rows wirh lot of datasheets.
The 2 nd button I have tried to work out with array vba. Same as I was helped before by @ P45Cal for another planning project i was working on.
I have try to modified it a bit and have come up with the below codes.
But the results are not consistent and also it is not taking into consideration the 1st,2nd and 3rd day load quantities when its displaying the results on the grid. And also it not starting the next order as per the required dates defined in column BK. Since it shall retrieved the date from the grid and validate from the column BK.
Frankly I don’t really know how to work with array but I have been able come out with something as below . I have make a lot of research but still cannot find the real code structure to make it work properly as the initial formula is doing.
Sub TEST_CALC_VBA_ARR()
'******************************************************* Main Calculation vba
With ThisWorkbook.Sheets("Main")
' LR = Cells(Rows.Count, "H").End(xlUp).Row
'LR = .Cells(.Rows.Count, "A").End(xlUp).Row ' defining the end of the data OK
LR = Cells(Rows.Count, "A").End(xlUp).Row
FR = .Range("MAIN_HEADER_ROW").Row + 1 ' defining the start row OK
WIPAry = .Range("AX" & FR & ":AX" & LR).Value 'col AX wip column OK
MaxMinDateAry = .Range("BK" & FR & ":BK" & LR).Value 'col BK block date column 0K
LineDeptAry = .Range("H" & FR & ":H" & LR).Value 'col H lines column OK
MinsLoadedAry = .Range("AX" & FR & ":AX" & LR).Value 'col OK total min sloaded ITS SAME AS WIP
MinMinsAry = .Range("BS" & FR & ":BS" & LR).Value 'col BS min qty OK
FirstDayLoadAry = .Range("BE" & FR & ":BE" & LR).Value ' COL BE 1ST DAY LOAD
SecondDayLoadAry = .Range("BF" & FR & ":BF" & LR).Value ' COL BF 2ND DAY LOAD
ThirdDayLoadAry = .Range("BG" & FR & ":BG" & LR).Value ' COL BG 3RD DAY LOAD
DateRowAry = .Range("Calender_Range").Value ' calander row
ReDim resultsAry(1 To .Range("CK12:IC" & LR).Rows.Count, 1 To .Range("CK12:IC" & LR).Columns.Count)
For rw = 1 To UBound(resultsAry)
If rw Mod 1 = 0 Then Application.StatusBar = "Computing Loaded Lines and Dept: " & rw & " of " & LR 'keeps the user informed of progress.
WIP = WIPAry(rw, 1)
MinsLoaded = MinsLoadedAry(rw, 1)
MinMins = MinMinsAry(rw, 1)
MaxMindate = MaxMinDateAry(rw, 1)
LineDept = LineDeptAry(rw, 1)
FIRSTDAYLOAD = FirstDayLoadAry(rw, 1)
SECONDDAYLOAD = SecondDayLoadAry(rw, 1)
THIRDDAYLOAD = ThirdDayLoadAry(rw, 1)
For colm = 1 To UBound(resultsAry, 2)
'Debug.Assert Not (rw = 10 And colm = 3)
ResultsColumnDate = DateRowAry(1, colm)
If WIP = "" Or MaxMindate = "" Or ResultsColumnDate < MaxMindate Then
resultsAry(rw, colm) = 0
Else
If FIRSTDAYLOAD > 0 Then
resultsAry(rw, colm) = FIRSTDAYLOAD
If MinsLoaded > 0 Or FIRSTDAYLOAD > 0 Or SECONDDAYLOAD > 0 Or THIRDDAYLOAD > 0 Then
AllPreviousDaysMins = 0
For i = 1 To colm - 1
AllPreviousDaysMins = AllPreviousDaysMins + resultsAry(rw, i)
Next i
RemainingMins = MinsLoaded - AllPreviousDaysMins - FIRSTDAYLOAD - SECONDDAYLOAD - THIRDDAYLOAD
If FIRSTDAYLOAD > 0 Or SECONDDAYLOAD > 0 Or THIRDDAYLOAD > 0 Then
'resultsAry(rw, colm) = Application.Value(FIRSTDAYLOAD, Application.Min(RemainingMins, MinMins))
End If
resultsAry(rw, colm) = Application.Min(RemainingMins, MinMins)
Else
End If
End If
End If
Next colm
Next rw
.Range("CK11").Resize(rw - 1, colm - 1).Value = resultsAry
End With
End Sub
Please see the attached file for better idea if needed.
I will be very grateful is someone can point me to the right direction, any tips or advise on how to interpret the formula into a VBA code may be this can help me out.
Thank you again in advance as many of my planning systems have been able to develop with the help of this forum for which I am very thankful to. These has help us decrease a lot of mistakes and save on a lot of time.
I hope everything is fine for you all.
I have been using this code below to load our factory . At first it was working quite well but after we started placing more orders to load its taking a lot of time to do the calculation almost 20-25 secs for every change we do which is very time consuming.
Sub Main_Normal_Calculation()
With Application
'.Cursor = xlWait
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Dim lLR As Long
Dim start_Time#, End_Time#
Sheets("Main").Activate
ActiveSheet.Unprotect
If ActiveSheet.AutoFilterMode _
Then Selection.AutoFilter
Call Remove_Format_On_Loading
'Call Order_Sequencing_Arrange
With ThisWorkbook.Sheets("Main")
lLR = Cells(Rows.Count, "H").End(xlUp).Row
End With
start_Time = Timer
Application.StatusBar = " Automate Calculation Started : Computing ...."
'reassigning the offset formula first due to add deletion rows.
Range("check_start_date_before_load").Select
Selection.Copy
Range("BJ12").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("CK10").Select
Application.CutCopyMode = False
With Range("CK12:IC" & lLR)
.Formula = "=IF(ISERROR(IF(CK$10<$BK12,0,IF(CK$10>=$BK12,IF(AND(CK$10=$BK12,$BE12<>""""),$BE12,IF(AND(CK$10=$BH12,$BF12<>""""),$BF12,IF(AND(CK$10=$BI12,$BG12<>""""),$BG12,IF(0<($AX12),MIN(($AX12-SUM($CJ12:CJ12)),$BS12)))))))),0,(IF(CK$10<$BK12,0,IF(CK$10>=$BK12,IF(AND(CK$10=$BK12,$BE12<>""""),$BE12,IF(AND(CK$10=$BH12,$BF12<>""""),$BF12,IF(AND(CK$10=$BI12,$BG12<>""""),$BG12,IF(0<($AX12),MIN(($AX12-SUM($CJ12:CJ12)),$BS12)))))))))"
.Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With
Call Build_Delivery_Assessment
Call Launching_Code
End_Time = Timer
Application.StatusBar = "Automated Planning Main Calculation Completed In " & Format(End_Time - start_Time, "0.000") & "secs"
Rows("10:10").Select
ActiveSheet.Unprotect
Selection.AutoFilter
Range("CK10").Select
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True
With Application
.Cursor = xlDefault
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = xlCalculationManual
End With
End Sub
The formula will derive the minimum quantity to plan daily based from column BS and also shall check the 1st , 2nd and 3rd day load. These 1st day, 2nd day and 3rd day load we normally give from every new styles starting on a particular line number which are from columns BE,BF,BG.
The 2nd day and 3rd day sometimes are optional and are based on the complexity of the style then we allocated if necessary the 2nd and 3rd day.
If also fetches the end date of the previous order from the grid where the calculation are done and cross checked with the block date given in column BC which after validates all in the column BK will start the next order for the particular line number. Please see the attached file to get a better idea of it .
I have place 2 buttons here on the rows 4,5,6 the first one is when click will calculate with the vba and the formula.
The formula is set to calculation automatic only when the formula is running due to several iterations that also are done for the calculation on the workbook. That is why I have set the calculation at start to manual and only calculate when the code is executed. I have also converted the formula to values after the calculation so that it does not go bigger in size as the planning itself has around 800-900 rows wirh lot of datasheets.
The 2 nd button I have tried to work out with array vba. Same as I was helped before by @ P45Cal for another planning project i was working on.
I have try to modified it a bit and have come up with the below codes.
But the results are not consistent and also it is not taking into consideration the 1st,2nd and 3rd day load quantities when its displaying the results on the grid. And also it not starting the next order as per the required dates defined in column BK. Since it shall retrieved the date from the grid and validate from the column BK.
Frankly I don’t really know how to work with array but I have been able come out with something as below . I have make a lot of research but still cannot find the real code structure to make it work properly as the initial formula is doing.
Sub TEST_CALC_VBA_ARR()
'******************************************************* Main Calculation vba
With ThisWorkbook.Sheets("Main")
' LR = Cells(Rows.Count, "H").End(xlUp).Row
'LR = .Cells(.Rows.Count, "A").End(xlUp).Row ' defining the end of the data OK
LR = Cells(Rows.Count, "A").End(xlUp).Row
FR = .Range("MAIN_HEADER_ROW").Row + 1 ' defining the start row OK
WIPAry = .Range("AX" & FR & ":AX" & LR).Value 'col AX wip column OK
MaxMinDateAry = .Range("BK" & FR & ":BK" & LR).Value 'col BK block date column 0K
LineDeptAry = .Range("H" & FR & ":H" & LR).Value 'col H lines column OK
MinsLoadedAry = .Range("AX" & FR & ":AX" & LR).Value 'col OK total min sloaded ITS SAME AS WIP
MinMinsAry = .Range("BS" & FR & ":BS" & LR).Value 'col BS min qty OK
FirstDayLoadAry = .Range("BE" & FR & ":BE" & LR).Value ' COL BE 1ST DAY LOAD
SecondDayLoadAry = .Range("BF" & FR & ":BF" & LR).Value ' COL BF 2ND DAY LOAD
ThirdDayLoadAry = .Range("BG" & FR & ":BG" & LR).Value ' COL BG 3RD DAY LOAD
DateRowAry = .Range("Calender_Range").Value ' calander row
ReDim resultsAry(1 To .Range("CK12:IC" & LR).Rows.Count, 1 To .Range("CK12:IC" & LR).Columns.Count)
For rw = 1 To UBound(resultsAry)
If rw Mod 1 = 0 Then Application.StatusBar = "Computing Loaded Lines and Dept: " & rw & " of " & LR 'keeps the user informed of progress.
WIP = WIPAry(rw, 1)
MinsLoaded = MinsLoadedAry(rw, 1)
MinMins = MinMinsAry(rw, 1)
MaxMindate = MaxMinDateAry(rw, 1)
LineDept = LineDeptAry(rw, 1)
FIRSTDAYLOAD = FirstDayLoadAry(rw, 1)
SECONDDAYLOAD = SecondDayLoadAry(rw, 1)
THIRDDAYLOAD = ThirdDayLoadAry(rw, 1)
For colm = 1 To UBound(resultsAry, 2)
'Debug.Assert Not (rw = 10 And colm = 3)
ResultsColumnDate = DateRowAry(1, colm)
If WIP = "" Or MaxMindate = "" Or ResultsColumnDate < MaxMindate Then
resultsAry(rw, colm) = 0
Else
If FIRSTDAYLOAD > 0 Then
resultsAry(rw, colm) = FIRSTDAYLOAD
If MinsLoaded > 0 Or FIRSTDAYLOAD > 0 Or SECONDDAYLOAD > 0 Or THIRDDAYLOAD > 0 Then
AllPreviousDaysMins = 0
For i = 1 To colm - 1
AllPreviousDaysMins = AllPreviousDaysMins + resultsAry(rw, i)
Next i
RemainingMins = MinsLoaded - AllPreviousDaysMins - FIRSTDAYLOAD - SECONDDAYLOAD - THIRDDAYLOAD
If FIRSTDAYLOAD > 0 Or SECONDDAYLOAD > 0 Or THIRDDAYLOAD > 0 Then
'resultsAry(rw, colm) = Application.Value(FIRSTDAYLOAD, Application.Min(RemainingMins, MinMins))
End If
resultsAry(rw, colm) = Application.Min(RemainingMins, MinMins)
Else
End If
End If
End If
Next colm
Next rw
.Range("CK11").Resize(rw - 1, colm - 1).Value = resultsAry
End With
End Sub
Please see the attached file for better idea if needed.
I will be very grateful is someone can point me to the right direction, any tips or advise on how to interpret the formula into a VBA code may be this can help me out.
Thank you again in advance as many of my planning systems have been able to develop with the help of this forum for which I am very thankful to. These has help us decrease a lot of mistakes and save on a lot of time.