Advice needed to speed up Painting code based on defined colors.

1 Attachment(s)

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 :

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.

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. :-)

Code:

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

1 Attachment(s)

Advice needed to speed up Painting code based on defined colors.

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.

Hello Artik,

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

Code:

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.

Code:

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.

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

Advice needed to speed up Painting code based on defined colors

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

Code:

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:

Code:

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

Code:

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

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

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?

Code:

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. :)

Code:

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 Sub

Artik

1 Attachment(s)

Advice needed to speed up Painting code

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.

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

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

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

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.

Quote:

Originally Posted by Artik

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