none
Writing to sheet - slow until clicking RRS feed

  • Question

  • Hello,

    I have encountered a very strange problem.

    My macro is supposed to consolidate data from one sheet to another.

    So far it was very fast, but now it is very slow.

    I noticed, that the macro is much faster after clicking into the sheet.

    this is the initial settings:

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual
    Application.AutoCorrect.AutoExpandListRange = False

    Even with screen updating = False it is slow.

    For testing purposes I also set up DoEvents (but it is slow even without this statement)

    Please see the animation and notice the percentage progress at the bottom:

    • After I click in the sheet, the sped is up like 100x. 
    • Another interesting fact: If I add selecting a cell in the code, it works the same way as manual mouse clicking.
    • The macro is not slow every time, but very often

    What can I do about this? I want this procedure to run "silently" and so that I want to avoid this clicking.

    EDIT:

    It happens in EXCEL 2010

    It does not happen always, I don't know yet how to purposefully cause it.

    The difference is: 167 seconds VS. 3 seconds

    Also: adding a cell selection to the code (one time only) speeds the marco as well

    The whole code is here:

    Sub EXP_varY_2_ACT()
        
    st = Now
    
    Application.ScreenUpdating = True 'To see the progress
    Application.Calculation = xlCalculationManual
    Application.AutoCorrect.AutoExpandListRange = False
    
    Dim max_mesic As Integer
    
    max_mesic = WorksheetFunction.max(Sheet3.Range("A:A"))
    
    Dim in_ws As Worksheet
    Set in_ws = Sheet2
    
    Dim OUT_WS As Worksheet
    Set OUT_WS = Sheet3
    
    
    Dim in_max_radek
    in_max_radek = WorksheetFunction.CountA(in_ws.Range("A:A"))
    
    Dim out_radek
    out_radek = WorksheetFunction.CountA(OUT_WS.Range("A:A")) + 1
    
    Dim mesic
    Dim rok
    Dim usek
    Dim jmeno
    Dim oddeleni
    Dim grupa
    Dim entita
    Dim sum_kc
    Dim sum_kc_Q
    Dim grade
    Dim pozice
    Dim rito
    Dim fte
    Dim BaseSalary
    Dim os_cis
    Dim zidle
    
    
    Dim in_r
    For in_r = 2 To in_max_radek
        
        Application.StatusBar = Round(in_r / in_max_radek, 2) * 100 & "% EXP varY to ACT"
        
        If InStr(in_ws.Cells(in_r, 5).Value2, "Y") <> True And _
        in_ws.Cells(in_r, 1).Value2 <= max_mesic And _
        in_ws.Cells(in_r, 2).Value2 = akt_rok Then
        
        
        For dvakrat = 1 To 2
            
            With in_ws
                mesic = .Cells(in_r, col_mesic).Value2
                rok = .Cells(in_r, Col_Rok).Value2
                usek = .Cells(in_r, col_usek).Value2
                jmeno = .Cells(in_r, Col_Jmeno).Value2
                oddeleni = .Cells(in_r, col_oddeleni).Value2
                
                entita = "Entita"
                grade = ""
                pozice = .Cells(in_r, Col_Profese).Value2
                rito = .Cells(in_r, col_RITO).Value2
                fte = .Cells(in_r, col_FTE).Value2
                BaseSalary = .Cells(in_r, col_BaseSalary_NUGGET).Value2
                os_cis = .Cells(in_r, Col_Os_cis).Value2
                zidle = .Cells(in_r, col_zidle).Value2
                
                
    '            Sheet3.Cells(4300, 1).Select
                
                Select Case dvakrat
                    
                Case 1
                    grupa = "Variable Pay Y"
                    grupa_Q = "Variable Pay"
                    sum_kc = .Cells(in_r, Col_exp_var_y).Value2 * .Cells(in_r, col_bonus_eligible).Value2
                    sum_kc_Q = .Cells(in_r, Col_var_4Q).Value2 
                Case 2
                    grupa = "HSSI"
                    grupa_Q = "HSSI"
                    sum_kc = .Cells(in_r, Col_exp_var_y).Value2 * .Cells(in_r, col_bonus_eligible).Value2 * 0.34
                    sum_kc_Q = .Cells(in_r, Col_var_4Q).Value2 * 0.34 
                    
                End Select
                
                
                
                
            End With
            If sum_kc <> 0 Then  
                
                With OUT_WS
                    .Cells(out_radek, 1).Value2 = mesic
                    .Cells(out_radek, 2).Value2 = rok
                    .Cells(out_radek, 3).Value2 = usek
                    .Cells(out_radek, 4).Value2 = jmeno
                    .Cells(out_radek, 5).Value2 = grupa
                    .Cells(out_radek, 6).Value2 = entita
                    .Cells(out_radek, 7).Value2 = sum_kc
                    .Cells(out_radek, 8).Value2 = oddeleni
                    .Cells(out_radek, 9).Value2 = grade
                    .Cells(out_radek, 10).Value2 = pozice
                    .Cells(out_radek, 11).Value2 = rito
                    .Cells(out_radek, 12).Value2 = fte
                    .Cells(out_radek, 13).Value2 = BaseSalary
                    .Cells(out_radek, 14).Value2 = os_cis
                    .Cells(out_radek, 16).Value2 = zidle
                End With
                DoEvents ' I can click into the sheet
                out_radek = out_radek + 1
            End If
            
            
            If sum_kc_Q <> 0 Then
                With OUT_WS
                    .Cells(out_radek, 1).Value2 = mesic
                    .Cells(out_radek, 2).Value2 = rok
                    .Cells(out_radek, 3).Value2 = usek
                    .Cells(out_radek, 4).Value2 = jmeno
                    .Cells(out_radek, 5).Value2 = grupa_Q
                    .Cells(out_radek, 6).Value2 = entita
                    .Cells(out_radek, 7).Value2 = sum_kc_Q
                    .Cells(out_radek, 8).Value2 = oddeleni
                    .Cells(out_radek, 9).Value2 = grade
                    .Cells(out_radek, 10).Value2 = pozice
                    .Cells(out_radek, 11).Value2 = rito
                    .Cells(out_radek, 12).Value2 = fte
                    .Cells(out_radek, 13).Value2 = BaseSalary
                    .Cells(out_radek, 14).Value2 = os_cis
                    .Cells(out_radek, 16).Value2 = zidle
                End With
                DoEvents ' I can click into the sheet
                out_radek = out_radek + 1
            End If
            
            
            
            Next dvakrat
            
        End If
        
        
        
        
        Next in_r
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.AutoCorrect.AutoExpandListRange = True
        
        
        temp = (Now - st) * (10 ^ 5)
        Debug.Print "EXP_varY_2_ACT - " & Round(temp, 3) & " s"
        
        
    End Sub


    • Edited by jakub dusek Thursday, February 15, 2018 12:06 PM
    Wednesday, February 14, 2018 3:43 PM

All replies

  • jakub,
    re:  erractic speed

    You omitted the code for the erratic part.
    Also, copying and pasting an entire range is generally faster than running a loop.

    If you are using a Mac and xl2016/365... the "next update" may or may not help.
    '---
    Jim Cone

    https://goo.gl/IUQUN2   (dropbox)

    Wednesday, February 14, 2018 11:52 PM
  • Hi jakub dusek,

    Which version of Excel you are using currently?

    From the Video, It's looks like you are using Excel 2003 or Excel 2007.

    Support for Office 2003 and Office 2007 is already ended.

    Did you try to create a new Workbook and try to reproduce the issue in new workbook?

    If not , Then you can try to make a test and let us know about the result.

    You did not posted the code so it is hard for us to find the issue.

    If possible for you then I suggest you to post your sample Workbook with dummy data in it.

    We will try to make a test with it on our side and try to find the issue in it.

    I would like to suggest you that , If you are using earlier versions of Office which are supported currently then you may try to upgrade to the latest version of MS Office will solve your issue.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, February 15, 2018 2:42 AM
    Moderator
  • Hello,

    I posted the whole code. the version is Excel 2010.

    James Cone: pasting the range is not possible, the macro transforms one table form (values in more columns) to consolidated form - only one value per row

    Thursday, February 15, 2018 11:54 AM
  • jakub,
    re: code issues

    I count 19 undeclared variables.
    st
    akt_rok
    dvakrat
    col_mesic
    Col_Rok
    col_usek
    Col_Jmeno
    col_oddeleni
    Col_Profese
    col_RITO
    col_FTE
    col_BaseSalary_NUGGET
    Col_Os_cis
    col_zidle
    grupa_Q
    Col_exp_var_y
    col_bonus_eligible
    Col_var_4Q
    temp

    Are these public variables or constants or just not declared?
    Are you using "Option Explicit"?  ('require variable declaration' should be checked)

      Jim Cone
    https://goo.gl/IUQUN2   (dropbox)


    • Edited by James Cone Friday, February 16, 2018 2:49 PM
    Thursday, February 15, 2018 2:43 PM
  • Hello James,

    All Col_* are column numbers declared as public constants, so is akt_rok

    The rest is undeclared indeed.

    I do not use option explicit setting, Do you think this could be causing the problem?

    Friday, February 16, 2018 1:53 PM
  • jakub,
    re:  option explicit

    Failure to use option explicit is probably not the cause of your problem.
    Using it is good coding practice and does prevent erors when typing variable names.

    Deepak has offered to check your code if you supply a sample workbook.

    '---
    Jim Cone
    https://goo.gl/IUQUN2   (dropbox)
    Friday, February 16, 2018 2:49 PM
  • Hello,

    I have created a dummy workbook, but I was not successful in reproducing the issue here.

    The original file is 66 MB, so the problem might be related to the size and complexity of it.

    Anyway the dummy file is here: https://drive.google.com/file/d/1C7YJVpZrL-4Kq4ewugP7X_2xXueCF8zS/view?usp=sharing

    Regards

    Tuesday, February 20, 2018 11:34 AM
  • Hi Jakub,

    For your image, I could see the unreasonable result, but I could not reproduce your issue by the provided file.

    To check whether it is related with your Office, I suggest you try to make a test with different computer with the same file.

    Currently, I would suggest you try to select a cell for a workaround.

    Best Regards,

    Tao Zhou


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Friday, February 23, 2018 8:36 AM