Consulting

Results 1 to 13 of 13

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

  1. #1
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    213
    Location

    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 :

    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.
    Attached Files Attached Files

  2. #2
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    374
    Location
    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

  3. #3
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    213
    Location

    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.
    Attached Files Attached Files

  4. #4
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    213
    Location
    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.

  5. #5
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    374
    Location
    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

  6. #6
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    213
    Location

    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

    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

  7. #7
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    374
    Location
    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 Sub
    Artik
    Last edited by Artik; 08-09-2020 at 07:06 AM.

  8. #8
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    213
    Location

    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.
    Attached Files Attached Files

  9. #9
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    374
    Location
    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

  10. #10
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    213
    Location
    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

  11. #11
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    374
    Location
    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
    Last edited by Artik; 08-10-2020 at 07:53 AM.

  12. #12
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    213
    Location
    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.

  13. #13
    VBAX Tutor
    Joined
    Sep 2009
    Posts
    213
    Location
    Quote Originally Posted by Artik View Post
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •