PDA

View Full Version : Advice needed to speed up Painting code based on defined colors.


VISHAL120
08-05-2020, 04:05 AM
Hello Everyone,

I hope everyone are safe and is taking good precaution during this pandemic period. Here in my country is still very high.

I am actually using the below code to “paint the rows and column” to better identify each Production line that has been planned.

Actually only the painting process is taking almost 60 secs to complete. Because the more we add the more time its taking. Right now if it is run it takes like 36 secs - 40 secs as I have decrease some of the orders in it.


Note : this is only a part of the planning system that I have attached as I am still working on it to make it more quicker.



What I have done to be able to do the painting of the rows and columns till now:



1. I have defined all the colors on a sheet which is name sheet “ lines”. I am attaching the file for better understanding. You can click on the button Click to Paint the production lines to see what it does for the painting.

2. The each production lines color are define on the column C from the sheet "lines" according to the Production line name. Just have a lot if not clear.


3. Then after we have done the planning we shall click on the button “Click to Paint the production lines” which runs the code for the painting.

The code shall paint the columns:
column G ,
column H and
Column CK to Column IC for which starting from cell CK12 to CI214 I have named it as Loading_Zone1 to be able to address the column and rows accordingly.

here is code :



Sub Painting_Dept_Identifier()

Dim start_Time#, End_Time#
Main_Order_No_Col = Range("Main_Order_Col").Column

Main_Dept_Col = Range("main_line_Number").Column
Main_Line_Column = Range("Main_Line_Number_02").Column
Main_Header_Row = Range("planning_header_row").Row + 2

'>>>Reading data from loading Zones
Row_Start = Range("Loading_Zones").Row
Column_Start = Range("Loading_Zones").Column
Column_End = Column_Start + Range("Loading_Zones").Columns.Count - 1

loading_Zones_row = Range("Loading_Zones").Row
'>>> doing the loop to place the color 1st on the loading data sheet
KL_Row_Index = Main_Header_Row


With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
start_Time = Timer

'Range("Loading_Zones").ClearFormats

Application.StatusBar = "Planning Calculation : Painting In Progress"

Do While Range("Main!A1").Offset(KL_Row_Index - 1, Main_Order_No_Col - 1) <> ""

Group_Identifier = Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1)

Select Case Group_Identifier
'>>> doing the loop to place the color 1st on the loading data sheet
Case Is = 1
Range("TATAMO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 2
Range("JBOURG").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 3
Range("ROME").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 4
Range("BERLIN").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 5
Range("TOLIPA").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 6
Range("VENISE").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 7
Range("_3_MIOVA").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 8
Range("M_DERA").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 9
Range("BRUXELLES").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 10
Range("N.YORK").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 11
Range("PEKIN").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 12
Range("M_CAR").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 13
Range("GENEVE").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 14
Range("TOKY").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

Case Is = 15
Range("EDEN").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

Case Is = 16
Range("PARIS").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 17
Range("TOKYO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 18
Range("P.LOUIS").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

Case Is = 19
Range("MEXICO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 20
Range("SYDNEY").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

Case Is = 21
Range("MUMBAI").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 22
Range("MADRID").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 23
Range("LONDON").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 24
Range("MAPUTO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

Case Is = 25
Range("DUBLIN").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats
Case Is = 26
Range("RIO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

Case Is = 27
Range("LISBONE").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

Case Is = 28
Range("PREPA").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

Case Is = 29
Range("SUBCON").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).PasteSpecial xlPasteFormats
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).PasteSpecial xlPasteFormats

End Select



For Column_Index = Column_Start To Column_End



'>>>> LOOP WHEN ZERO VALUES FOR EFFICIENT COLORING

If Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1) = 0 Then

GoTo Skip_Column

End If




'>>>>>>>>>>>>>>> Identify the group to color and start setting the colors on the loading zones of each _
order and row.

Group_Identifier = Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1)

Select Case Group_Identifier
'>>> doing the loop to place the color 1st on the loading data sheet

Case Is = 1
Range("TATAMO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 2
Range("JBOURG").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 3
Range("ROME").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 4
Range("BERLIN").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 5
Range("TOLIPA").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 6
Range("VENISE").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 7
Range("_3_MIOVA").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 8
Range("M_DERA").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 9
Range("BRUXELLES").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 10
Range("N.YORK").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 11
Range("PEKIN").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 12
Range("M_CAR").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 13
Range("GENEVE").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 14
Range("TOKY").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 15
Range("EDEN").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 16
Range("PARIS").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 17
Range("TOKYO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 18
Range("P.LOUIS").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 19
Range("MEXICO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 20
Range("SYDNEY").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 21
Range("MUMBAI").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 22
Range("MADRID").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 23
Range("LONDON").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 24
Range("MAPUTO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 25
Range("DUBLIN").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats
Case Is = 26
Range("RIO").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 27
Range("LISBONE").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 28
Range("PREPA").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

Case Is = 29
Range("SUBCON").Copy
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).PasteSpecial xlPasteFormats

End Select


'End If




SKIP_ROW:
Skip_Column:
Next Column_Index
'loading_Zones_row = loading_Zones_row + 1
KL_Row_Index = KL_Row_Index + 1

Loop
'


' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
' , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
' AllowFormattingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
' AllowFiltering:=True

'Sheets("Master_Visual").Range("MVisual_Str") = "Y"



End_Time = Timer
Application.StatusBar = " Painting Completed In " & Format(End_Time - start_Time, "0.000") & "secs"
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With



End Sub








I will be very grateful if I can get some guidance for speeding the painting process to may be 10 secs or less as actually its taking me almost 60 secs to complete the whole painting to identify the production lines.


Thank you in advance for all advise and recommendations.
Have a nice day and stay safe.
Artik
08-05-2020, 05:40 AM
You've made this code very complicated. The main problem with it is copying and pasting cells (their formats).
Staying in the convention of your code, see how it shortened. Execution time too. :-)

Sub Painting_Dept_Identifier_1()


Dim start_Time#, End_Time#
Dim rngDefinedColors As Range

Main_Order_No_Col = Range("Main_Order_Col").Column


Main_Dept_Col = Range("main_line_Number").Column
Main_Line_Column = Range("Main_Line_Number_02").Column
Main_Header_Row = Range("planning_header_row").Row + 2


'>>>Reading data from loading Zones
Row_Start = Range("Loading_Zones").Row
Column_Start = Range("Loading_Zones").Column
Column_End = Column_Start + Range("Loading_Zones").Columns.Count - 1


loading_Zones_row = Range("Loading_Zones").Row
'>>> doing the loop to place the color 1st on the loading data sheet
KL_Row_Index = Main_Header_Row


With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

start_Time = Timer


'Range("Loading_Zones").ClearFormats

Set rngDefinedColors = Worksheets("Lines").Range("C2:C30")


Application.StatusBar = "Planning Calculation : Painting In Progress"


Do While Range("Main!A1").Offset(KL_Row_Index - 1, Main_Order_No_Col - 1) <> ""


Group_Identifier = Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1)

Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).Interior.Color = rngDefinedColors.Cells(Group_Identifier).Interior.Color
Range("Main!A1").Offset(KL_Row_Index - 1, Main_Line_Column - 1).Interior.Color = rngDefinedColors.Cells(Group_Identifier).Interior.Color




For Column_Index = Column_Start To Column_End


'>>>> LOOP WHEN ZERO VALUES FOR EFFICIENT COLORING


If Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1) = 0 Then


GoTo Skip_Column


End If




'>>>>>>>>>>>>>>> Identify the group to color and start setting the colors on the loading zones of each _
order and row.
Group_Identifier = Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1)
Range("Main!A1").Offset(KL_Row_Index - 1, Column_Index - 1).Interior.Color = rngDefinedColors.Cells(Group_Identifier).Interior.Color


SKIP_ROW:
Skip_Column:
Next Column_Index
'loading_Zones_row = loading_Zones_row + 1
KL_Row_Index = KL_Row_Index + 1


Loop
'


' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
' , AllowFormattingCells:=True, AllowFormattingColumns:=True, _
' AllowFormattingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
' AllowFiltering:=True


'Sheets("Master_Visual").Range("MVisual_Str") = "Y"


End_Time = Timer
Application.StatusBar = " Painting Completed In " & Format(End_Time - start_Time, "0.000") & "secs"
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With


End Sub
And that's not the optimal code yet. But maybe that's enough for you.

Artik
VISHAL120
08-05-2020, 06:49 AM
Hello Artik,

thank you for your kind response.

I have just checked the code on the attachment and it runs quite quick but its changes only the interior color and not the font color which has been set according to the cell defined for each production line.

example : if you checked the cell in sheet lines cell C5 the interior color is like dark grey but the font is white. So when its painting it shall changed the color to dark grey same as the cell C5 from sheet lines and also set the font color to white same as the cell font color.

I am attaching the file with the code you gave and you will see on the sheet main as from row 58 its has not change the fonts to white as it shall be when in sheet lines cell C5.

Thank you again for the kind help if you can just advise for the fonts side it will make it.
VISHAL120
08-05-2020, 07:07 AM
Hello Artik,

I have finally been able to adjust it for the font with this code. thank you again.



Range("Main!A1").Offset(KL_Row_Index - 1, Main_Dept_Col - 1).Font.Color = rngDefinedColors.Cells(Group_Identifier).Font.Color


I have this code also which takes almost 25sec - 40 secs for pasting the formula and converting to values. can you please give me an advise on this one also please. this will help me a lot to change the speed of work of the planning.

here is the code am actually using to make the calculation for planning and the converting all in values.



Sub Main_Normal_Calculation()
With Application
'.Cursor = xlWait
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With


Dim lLR As Long

Sheets("Main").Activate
ActiveSheet.Unprotect

If ActiveSheet.AutoFilterMode _
Then Selection.AutoFilter


Call Remove_Format_On_Loading


With ThisWorkbook.Sheets("Main")
lLR = Cells(Rows.Count, "H").End(xlUp).Row
End With


start_Time = Time





Application.StatusBar = " Automate Calculation Started : Computing ...."




With Range("CK12:HJ" & 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




'MsgBox Timer - startTime & " secs."




End_Time = Time
Time_String = Format(End_Time - start_Time, "ss")
Application.StatusBar = " Planning Calculation processed in " & Time_String & " 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


thank you in advance for your time and help.
Artik
08-05-2020, 03:27 PM
In the code presented, there is no access to procedures:
Remove_Format_On_Loading
Build_Delivery_Assessment
Launching_Code


And the problem probably does not lie in the use of formulas and conversion to values (for me, about 5-6 seconds), but probably in the procedures that you did not provide.

Artik
VISHAL120
08-05-2020, 09:22 PM
Hi Artik,

Good morning,

Here below are the complete code that i am using for the :
Remove_Format_On_Loading
Build_Delivery_Assessment
Launching_Code

procedures.

I have infact tested again the sub procedures separately so as to understand really what is taking more time and the time taken for each sub procedure are as follows:

Remove_Format_On_Loading : 0.338 seconds
Build_Delivery_Assessment : 2.885 seconds
Launching_Code : 1.67 seconds.

and the main calculation itself takes: 15.40 seconds.

that is why i have given only the code for the main calculation first.

Nevertheless here below the complete code of the sub procedures:

Code for Remove_Format_On_Loading



Sub Remove_Format_On_Loading()


Dim start_Time#, End_Time#



start_Time = Timer

Range("Loading_Zone1").Select

' With Selection.Font
' .ThemeColor = xlThemeColorDark2
' .TintAndShade = 0
' End With


Range("loading_Zone1").ClearContents

With Selection
.Font.ThemeColor = xlThemeColorLight1
'.ThemeColor = xlThemeColorDark2
.Borders.LineStyle = xlNone
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With

End_Time = Timer
Application.StatusBar = "Karina Automated Planning Main Calculation Completed In " & Format(End_Time - start_Time, "0.000") & "secs"

End Sub





code for the main calculation again here:



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

' =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)))))))

Call Build_Delivery_Assessment
Call Launching_Code


'MsgBox Timer - startTime & " secs."


End_Time = Timer
Application.StatusBar = "Karina 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





code for the Build_Delivery_Assessment




Sub Build_Delivery_Assessment()
'copy data from main planning to delivery assessment.
With Application
'.Cursor = xlWait
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationAutomatic
End With

'Dim start_Time#, End_Time#
'start_Time = Timer
Sheets("dEL_ANALYSIS").Unprotect
Sheets("Main").Range("Delivery_Data1").Copy Destination:=Sheets("Del_Analysis").Range("F12")

Sheets("Main").Range("Delivery_Data2").Copy Destination:=Sheets("Del_Analysis").Range("CC12")

Sheets("Main").Range("Delivery_Data3_ProduceU").Copy Destination:=Sheets("Del_Analysis").Range("AW12")



Sheets("Main").Range("Delivery_Data4_TCO").Copy Destination:=Sheets("Del_Analysis").Range("Cf12")
Sheets("main").Range("BM12").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True

End_Time = Timer
'Application.StatusBar = "Karina Automated Planning Main Calculation Completed In " & Format(End_Time - start_Time, "0.000") & "secs"
With Application
'.Cursor = xlWait
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = False
.Calculation = xlCalculationManual
End With

End Sub




Launching_Code



Sub Launching_Code()
Dim i As Integer
Dim j As Integer

Dim LAUNCHINGCOLOR As Long
' Dim OrangeRefColor As Long
' Dim RedRefColor As Long

Dim cntGreen As Long
Dim cntOrange As Long
Dim cntRed As Long

' Dim start_Time#, End_Time#
'
'
'
'start_Time = Timer

Sheets("Main").Activate
ActiveSheet.Unprotect

LAUNCHINGCOLOR = Range("LAUNCHING").DisplayFormat.Interior.Color
' OrangeRefColor = Range("OrangeRef").DisplayFormat.Interior.Color
' RedRefColor = Range("RedRef").DisplayFormat.Interior.Color

i = 0
j = 0

'For j = Range("Qtr1S1").Column To Range("Qtr4S3").Column
For j = Range("launch_col_strt01").Column To Range("launch_col_end_01").Column
cntGreen = 0
cntOrange = 0
cntRed = 0

Application.ScreenUpdating = False

For i = Range("launch_col_strt01").Row To Range("launch_row_end01").Row

Select Case Cells(i, j).DisplayFormat.Interior.Color
Case LAUNCHINGCOLOR

cntGreen = cntGreen + 1

Case OrangeRefColor

cntOrange = cntOrange + 1

Case RedRefColor

cntRed = cntRed + 1

End Select

Next i

'Application.ScreenUpdating = True

Cells(Range("LAUNCHING").Row, j) = cntGreen
' Cells(Range("OrangeRef").Row, j) = cntOrange
' Cells(Range("RedRef").Row, j) = cntRed

Next j

' End_Time = Timer
'Application.StatusBar = "Karina Automated Planning Main Calculation Completed In " & Format(End_Time - start_Time, "0.000") & "secs"


ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True

Application.ScreenUpdating = True



End Sub




thanks to check if we can still ameliorate the calculation if possible.

thank you again for the support
Artik
08-09-2020, 06:55 AM
Unfortunately, the computational complexity of the inserted formula is quite high, which will result in a long execution time.
Comments.
1) I don't know if you are in good control of the calculation process in the workbook. What is the purpose of enabling automatic calculation in this snippet?
With Range("CK12:IC" & lLR)
.Formula = "=IF(ISERROR(IF(CK$10<$BK12,0,IF(CK$10>=$BK12,IF(AND(CK$10=$BK12,$BE12<>"""")(...)"
.Application.Calculation = xlCalculationAutomatic
.Value = .Value
End With

Inserting into a range of formulas already calculates them. If the inserted formulas affect other cells (beyond the range inserted), it makes sense to enable automatic calculation. But in this case, I found no connections.
If you want to calculate a workbook without turning on automatic calculation, you can do it using one of the methods:
Application.CalculateFull
Application.Calculate
Worksheet.Calculate
Range.Calculate
Either you have to accept this macro execution time, or you could shorten the formula's calculation chain. You may also consider changing the formulas to a VBA procedure. While formulas are quite fast, there are times when VBA is faster.
2) Conditional formatting also has a big impact on the computation speed (the less CFs the better). Review the CF list and delete unnecessary.
3) The only thing I managed to shorten was the Launching_Code operation time by about 30%. But it is too little consolation for you. :)
Sub Launching_Code()

Dim j As Long

Dim LAUNCHINGCOLOR As Long
Dim OrangeRefColor As Long
Dim RedRefColor As Long

Dim cntGreen As Long
Dim cntOrange As Long
Dim cntRed As Long

Dim vCounters As Variant
Dim rngCell As Range

Dim start_Time#, End_Time#

start_Time = Timer

Sheets("Main").Activate
ActiveSheet.Unprotect

LAUNCHINGCOLOR = Range("LAUNCHING").DisplayFormat.Interior.Color
' OrangeRefColor = Range("OrangeRef").DisplayFormat.Interior.Color
' RedRefColor = Range("RedRef").DisplayFormat.Interior.Color

ReDim vCounters(1 To (Range("Loading_Zone1").Columns.Count))

Application.ScreenUpdating = False

For j = 1 To Range("Loading_Zone1").Columns.Count
cntGreen = 0
cntOrange = 0
cntRed = 0

For Each rngCell In Range("Loading_Zone1").Columns(j).Cells

Select Case rngCell.DisplayFormat.Interior.Color
Case LAUNCHINGCOLOR

cntGreen = cntGreen + 1

Case OrangeRefColor

cntOrange = cntOrange + 1

Case RedRefColor

cntRed = cntRed + 1

End Select

Next rngCell

'Cells(Range("LAUNCHING").Row, j) = cntGreen
'Cells(Range("OrangeRef").Row, j) = cntOrange
'Cells(Range("RedRef").Row, j) = cntRed

vCounters(j) = cntGreen
Next j

Range("LAUNCHING").Offset(, 2).Resize(, UBound(vCounters)).Value = vCounters

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True

Application.ScreenUpdating = True

End_Time = Timer

Debug.Print "Launching_Code: " & Format(End_Time - start_Time, "0.000")

End SubArtik
VISHAL120
08-10-2020, 04:31 AM
Dear Artik,

Sorry for the delay in getting back to you its mainy due to time difference.

I highly appreciate your help and time Sir. Thank you again for this kind help and advise.

The purpose of enabling calculation is because the workbook has many iteration and there are also other sheets which are calculated that is why i have set the calculation to manual and only calculates when we run the codes.

I am also converting the formula to values so as not to increase the workbook file size.

I was really looking to do it with VBA but i have not been able to figure it till now but am still thinking of how to do it with VBA as you advise.

If you can guide me this will be a lot of help please.

I am attaching a sample for better understanding of the calculation for the part we are discussing. Normally we have around 600-700 rows of data to analyse when we plan the orders. i have put like 95 rows of data in the sample file for better understanding and also to decrease the file size.

Also there are many hidden columns on the sheet which is very important i have just hide it and leave only the column which are concern for the calculation.

I have assign the codes for the loading on the button on top name " Click to load" and i have assign also the code for painting on the button " click to paint" for better understanding when you will test it. The code for the painting is in fact the code you have help me with to decrease the time taken for painting.

You will see there are lot of dependencies before the calculation can process. Like the 1st day Limit,2nd day limit,3rd day limit from column BE to BG. Also for the start date of the next order it depends on the previous order completion date for a particular line and also which date we have defined on the column BC and column AY for the capacity adjustment.

Please try to run it at your end you will get it how it works actually.

Thank you again for the time and i am open for any suggestions and advice for doing it in VBA instead of formula.
Artik
08-10-2020, 06:49 AM
Can you tell me what triggers the following functions:
Start_MakeUp
End_MakeUp
and eventually
Start_Embro
End_Emb
because in this thicket ;) it is difficult for me to find.

Artik
VISHAL120
08-10-2020, 07:22 AM
Hi Artik,
These functions normally they fectches the dates from the planner where the calculation are done.
Start_MakeUp: this fetch the start date when the first quantity is placed on the planner after the calculation.
End_MakeUp: this fetch the date when the last quantity is placed on the planner after the calculation.

example : if an order is loaded as follow on the planner where the calculations are done like

10/08 11/08 12/08 13/08 14/08 15/08 16/08
20 100 300 300 150 0 0

so the
Start_MakeUp will be 10/08 and
End_MakeUp will be 14/08
this where it will get the dates for the start and end make up

these 2 below are for another sheet calculation so it don’t apply here
Start_Embro
End_Emb

i hope this help you to understand it . Thanks again for your kind help in advance
Artik
08-10-2020, 07:37 AM
But where are the formulas that use functions:
Start_MakeUp
End_MakeUp?
Point out where you use them, because I can't find them.


..::Edit
OK, I have already found the BL and BM columns.
You use the calculations from the BM columns in the BJ column. And do you use the calculations from the BL column somewhere?::..


Artik
VISHAL120
08-10-2020, 07:52 AM
hi,

Its in the column BL for the Start_Makeup and column BM for the End_Makeup.

if you try to edit it you will see its fetching the dates from the planner where the first quantity is place and the last quantity for the end date together with the calender from the row CK10 to IC10.

If you see row 13 you will see it fetch the start date as 07/08 as it start here with 20 pcs and the end date as 11/08 as it complete the quantity here with 3 pcs.

I hope this helps.
VISHAL120
08-10-2020, 11:15 AM
But where are the formulas that use functions:
Start_MakeUp
End_MakeUp?
Point out where you use them, because I can't find them.


..::Edit
OK, I have already found the BL and BM columns.
You use the calculations from the BM columns in the BJ column. Vishal120 reply:Yes correct it use to determine the previous order end date and make a check of the block date set by us to start the loading of the actual order


And do you use the calculations from the BL column somewhere?::..Vishal120 reply: No it is not use. it is use only on the column BJ


Artik