1 Attachment(s)
Advice needed to speed up Painting code based on defined colors.
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.
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.
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
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.