Why my VBA code runs faster when clicking on the Immediate Window?

[Attilio]

I have written a macro in Excel VBA that calculates iteratively a range of physical variables and, at each iteration, re-calculates the values of other correlated variables in the worksheet.


I have run the code from the Visual Basic editor in order to monitor the value of some variables at each iteration through the Immediate Window. I was surprised to notice a sudden acceleration of the execution simply by clicking with the mouse on the Immediate Window, or by pressing Enter. On the contrary,when the macro is run from the spreadsheet, its execution is about five time slower and I found no way to accelerate it.


I wonder what is the reason of the acceleration in the execution when clicking on the Immediate Window and how I could speed up the code without this trick.


I am using Excel 2013 and Windows 8.1.


Thank you very much for considering this question.

[mikerickson]

I can't tell without looking at the code, but I suspect that the code writes to a worksheet, which takes time and doesn't happen in the immediate window.
If not writing to cells, some expression on a worksheet.

Have you tried putting toggling Application.ScreenUpdating off at the start and on after (and .Calculation)?

[Attilio]

Dear Mike,

Thank you very much for your quick feedback to my post. Yes, I have tried with disabling both screen updating and calculation of the worksheets not related to the iterations of the code, but this has not helped to reduce the calculation time when the macro is run from Excel. The odd thing is that a click on the immediate window is enough to make a big difference in calculation speed.

I will send to you the file with the code, it would be really kind if you could have a look at it.

Regards

[mikerickson]

If you remove sensitive data you can attach a copy of the workbook to a post.

[Attilio]

Here is the code, thanks again.

Sub Solve()


'   ------------------ Initial time
    Dim Initial_time As Date
    Initial_time = Now()
    

'   ------------------ Disables calculation of selected worksheets
    Worksheets("Demisters").EnableCalculation = False
    Worksheets("Graph").EnableCalculation = False
    Worksheets("Summary").EnableCalculation = False
    
    
'   ------------------ Disables screen updating
    Application.ScreenUpdating = False
    
 
'   ------------------- Maximum number of iterations in evaluating formulas
    Application.MaxIterations = 100


'   ------------------- Initialization

Dim T_Brine As Range, T_Condenser_in As Range, T_Condenser_out As Range, Error_HEX As Range
Dim Upper_T_Brine As Range, Lower_T_Brine As Range
Dim NS_Rec As Integer, NS_Rej As Integer, i As Integer
Dim Damp As Single, Toll As Single, DT As Single
Dim Tt As Single, T_SW_in As Single, Gb As Single, Flow_Rej_SW As Single
Dim cp_SW_in As Single, cp_SW_out As Single, HF_Reject_Condensers_HB As Single
Dim T_Brine_BH_in As Range, T_SW_out As Range, Error_HB_Stages As Range, Error_BRT As Range
Dim E_1 As Range, E_2 As Range, E_3 As Range
Dim Iter As Integer
Dim Flag As Boolean

'   Assigns the correspondence between the values of named ranges in the workbook and range variables in the VBA code
Set T_Brine = Range("T_Brine")
Set T_Condenser_in = Range("T_Condenser_in")
Set T_Condenser_out = Range("T_Condenser_out")
Set Error_HEX = Range("Error_HEX")
Set Upper_T_Brine = Range("Upper_T_Brine")
Set Lower_T_Brine = Range("Lower_T_Brine")
Set T_Brine_BH_in = Range("T_Brine_BH_in")
Set T_SW_out = Range("T_SW_out")
Set Error_HB_Stages = Range("Error_HB_Stages")  'Error in the sum of the errors in heat balance of all stages (squared)
Set Error_BRT = Range("Error_BRT")              'Error in the overall heat balance of the plant
Set E_1 = Range("E_1")                          'Auxiliary range for recording the values of a parameter at each iteration
Set E_2 = Range("E_2")                          'Auxiliary range for recording the values of a parameter at each iteration
Set E_3 = Range("E_3")                          'Auxiliary range for recording the values of a parameter at each iteration

'   Assigns the values of named cells in the workbook
NS_Rec = Range("NS_Rec")
NS_Rej = Range("NS_Rej")

'   Assignment of parameter values
Damp = 0.2      'Damping coefficent for flashing brine temperature update
Toll = 0.001    'Tolerance on error for convergence
DT = 3          'Reference temperature differential
Damp_BRT = 0.05 'Damping coefficient for T_Brine_BH_in iterations
Toll_BRT = 0.1  'Tolerance on error on brine recirculation temperature
Iter = 0
Flag = False
    
    
'   --------------- Guess initial values
    Call Guess(Tt, T_SW_in, Gb, Flow_Rej_SW, NS_Rec, NS_Rej)

    
'   ---------------- Iterates on the value of the brine temperature at BH inlet
'                    by minimization of the difference between the temperatures of brine in the last evaporator stage
'                    and the temperature of recirculating brine to the recovery condensers

Continue:
Iter = Iter + 1

'   After the first pass, recalculates the value of seawater discharge temperature by overall heat balance
    If (Flag) Then
        cp_SW_in = Range("cp_SW_in")
        cp_SW_out = Range("cp_SW_out")
        Flow_Rej_SW = Range("Flow_Rej_SW")
        HF_Reject_Condensers_HB = Range("HF_Reject_Condensers_HB")      'Heat Flux in the condensers of the Reject Section
        T_SW_out = T_SW_in * cp_SW_in / cp_SW_out + HF_Reject_Condensers_HB / (Flow_Rej_SW * cp_SW_out)
        '          T_SW_in value defined in the subroutine Guess
        End If
                
Flag = True
        
'   Iterates on the values of brine temperature in recovery stages to minimize the error in the heat flux exchanged through the condensers
For i = 1 To NS_Rec
    While (Abs(Error_HEX(i, 1))) > Toll
        T_Brine(i) = T_Brine(i) + DT * Error_HEX(i) * Damp
        If (T_Brine(i) > Upper_T_Brine(i)) Then
            T_Brine(i) = Upper_T_Brine(i)
            End If
        If (T_Brine(i) < Lower_T_Brine(i)) Then
            T_Brine(i) = Lower_T_Brine(i)
            End If
                Debug.Print i, T_Brine(i), T_Condenser_out(i), Error_HEX(i)
        Wend
     Next i

'   Iterates on the values of brine temperature in recovery stages to minimize the error in the heat flux exchanged through the condensers
For i = NS_Rec + 1 To NS_Rec + NS_Rej
    While (Abs(Error_HEX(i, 1))) > Toll
        T_Brine(i) = T_Brine(i) + DT * Error_HEX(i) * Damp
        If (T_Brine(i) > Upper_T_Brine(i)) Then
            T_Brine(i) = Upper_T_Brine(i)
            End If
        If (T_Brine(i) < Lower_T_Brine(i)) Then
            T_Brine(i) = Lower_T_Brine(i)
            End If
                Debug.Print i, T_Brine(i), T_Condenser_out(i), Error_HEX(i)
        Wend
    Next i

'   Records the values at each iteration
    E_1(Iter) = Error_HB_Stages
    E_2(Iter) = Error_BRT
    E_3(Iter) = T_Brine_BH_in
    
'   Recalculates the value of BH inlet temperature based on the error in brine recirculation temperature
    If Abs(Error_BRT) > Toll_BRT Then
        T_Brine_BH_in = T_Brine_BH_in - Error_BRT * Damp_BRT
        GoTo Continue
        End If
        
        
'   ------------------- Enables scren updating
    Application.ScreenUpdating = True
    
    
'   ------------------- Enables calculation of selected worksheets and calculates
    Worksheets("Demisters").EnableCalculation = True
    Worksheets("Graph").EnableCalculation = True
    Worksheets("Summary").EnableCalculation = True
    Worksheets("Demisters").Calculate
    Worksheets("Graph").Calculate
    Worksheets("Summary").Calculate
    

'   ------------------- Elapsed time
    Sheets("Summary").Range("Elapsed_time").Value = (Now() - Initial_time) * 24 * 60
        
        
   
End Sub

[mikerickson]

I haven't gone through the code, but this caught my eye

'Auxiliary range for recording the values of a parameter at each iteration

If you are intreating within your sub, writing values to a sheet, every iteration will eat time tremendously. It would be far faster to store intermediate values in VBA variables than writing them to ranges.

I suspect that the function Guess (not shown) might have similar issues of over-writing to cells.

[Attilio]

The code in fact uses range variables to store the values calculated at each iteration. This looks necessary because the spreadsheet, in turn, updates at each iteration the values of local variables based on the new values of the range variables stored by the code in the cells.

I am fully aware that this interaction at each iteration is time-consuming, and have to accept this as long as I do not see alternatives. My point is that exactly the same code turns out to be much faster simply by clicking on the Immediate Window during its execution.

[PatBed]

Hi,
I have the exact same problem, have you figured it out ?

[SamT]

I would start by refactoring the code.
You declare a lot of Range Variables, then set them to Named Ranges, then assign their Values to other Variables. Just assign the Values of the Named Ranges on the Sheet, Skip the intermediary step of Range Variables.

Move all Declarations out of the Sub to the Module. Set their Values in an Init Sub

Use an Initialized Flag like this in the Main code sub
If Not Inititialized then Init

E-1,E-2, & E-2 are used as Arrays, but you initially set them to a single cell's Value. Declare them like
Dim E-1(1 to MaxIterations) As Variant

Move all Sub_Routines in the main code to Subs or Functions

If (Flag) Then
cp_SW_in = Range("cp_SW_in")
cp_SW_out = Range("cp_SW_out")
Flow_Rej_SW = Range("Flow_Rej_SW")
HF_Reject_Condensers_HB = Range("HF_Reject_Condensers_HB") 'Heat Flux in the condensers of the Reject Section
T_SW_out = T_SW_in * cp_SW_in / cp_SW_out + HF_Reject_Condensers_HB / (Flow_Rej_SW * cp_SW_out)
' T_SW_in value defined in the subroutine Guess
End If

Becomes
If (Flag) Then GetSeawaterDischargeTemp
And

Private Sub GetSeawaterDischargeTemp()
        cp_SW_in = Range("cp_SW_in")
        cp_SW_out = Range("cp_SW_out")
        Flow_Rej_SW = Range("Flow_Rej_SW")
        HF_Reject_Condensers_HB = Range("HF_Reject_Condensers_HB") 'Heat Flux in the condensers of the Reject Section
        T_SW_out = T_SW_in * cp_SW_in / cp_SW_out + HF_Reject_Condensers_HB / (Flow_Rej_SW * cp_SW_out)
         '          T_SW_in value defined in the subroutine Guess
End Sub

[PatBed]

Thanks for your quick response SamT. I meant to say that I have the exact same problem as I have to click on my Excel sheet while the macro is running, to let it finish quickly. In other words, if a click on a button that execute the macro and don't touch anything, it takes 70seconds to execute. If during this 70 seconds, a click anywhere on my spreadsheet (to gain focus), it accelerate the process and can take as low as 7 seconds to runHave you seen this before ?

[offthelip]

Although I can't answer your question, I can suggest that you can speed up your code by a factor of 100 or so if you use variant arrays instead of setting variable to ranges, see this thread that I started comparing the times of the technique you are using to variant arrays:
http://www.vbaexpress.com/forum/show...+variant+array

[PatBed]

Thanks for your answer!
I am not an advanced developper in VBA...So I tried to see based on your comments, how I can improve the performance of my macro, but could not do better so far. Here is my code...
If someone can improve its performance (and by the way, improve its structure, because I am not good at making nice functions to help make the code easy to rea), I am ready to offer a little money!

Sub OngletSprints()
'
' Affichage de l'onglet Sprints
'


'On Error GoTo errHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False



Dim NoSprint As Integer 'Numéro du sprint
Dim LS As Integer 'Numéro de la ligne dans l'onglet Sprint, où nous insérons
Dim LR As Integer 'Numéro de la ligne dans l'onglet Récits utilisateur, où nous lisons
Dim THEME As String 'le nom du Theme et Epics pour le récit
Dim LigneDebutSprint As Integer '# de rangée du début d'un sprint
Dim LigneFinSprint As Integer '# de rangée de la fin d'un sprint
Dim RecitDone
Dim Detail As String
Dim BoucleRecit
Dim LastRow As Integer
Dim xComment As Comment
Dim PointsPlanifies As Integer
Dim LigneEnteteSprint As Integer
Dim Livraison As String
Dim NbreDeRecits As Integer


Dim LigneDeDebut As Integer
LigneDeDebut = 646 'On veut refaire l'onglet à partir de cette ligne seulement (Début Sprint #20)pour éviter que la macro soit trop long à exécuter
Dim LignesASupprimer
LignesASupprimer = LigneDeDebut & ":5000"
Dim LigneDebutRecit As Integer
LigneDebutRecit = 575 'On commence à 575 puisque c'est là que débute les récits de la LMG
Dim LignesACacher


NbreDeRecits = Sheets("Récits Utilisateurs").Range("B" & Rows.Count).End(xlUp).Row

Sheets("Sprints").Unprotect
'Sheets("Sprints").Cells.Delete 'On efface tout le contenu de la feuille
Sheets("Sprints").Rows(LignesASupprimer).Delete 'On efface les lignes qui suivent cette ligne




'On ne fait plus cette partie puisqu'on garde les premières lignes du de la livraison #1 intactes


'On enlève tous les groupes de colonnes
Sheets("Sprints").Columns("A:Z").Select
Selection.Ungroup


Sheets("Sprints").Cells.VerticalAlignment = xlCenter


LS = 1


Sheets("Sprints").Rows.Font.Size = 8
Sheets("Sprints").Rows.RowHeight = 12


NoColoneEntete = 1
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 1


NoColoneEntete = NoColoneEntete + 1
'Colonne B 2 (Épic)
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 10
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 1


NoColoneEntete = NoColoneEntete + 1
' Colonne C 3 (Récits utilisateurs)
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 90
Sheets("Sprints").Columns(NoColoneEntete).WrapText = True


' Colonne D 4 (# TFS)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "#" & Chr(10) & "TFS"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 5
Sheets("Sprints").Columns(NoColoneEntete).HorizontalAlignment = xlCenter


' Colonne E 5 (Pts)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Pts"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 3


' Colonne F 6 (Équipe)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Éq."
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 3
Sheets("Sprints").Columns(NoColoneEntete).HorizontalAlignment = xlCenter


' Colonne G 7 (Analyste Fonctionnel)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "A.F."
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 7


' Colonne H 8 (Date Kick-off)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Kick" & Chr(10) & "-Off"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 6
Sheets("Sprints").Columns(NoColoneEntete).HorizontalAlignment = xlCenter
Sheets("Sprints").Range(Cells(LS + 1, NoColoneEntete), Cells(LS + 5000, NoColoneEntete)).NumberFormat = "d-mmm"


' Colonne I 9 (Avancement Architecture Fonctionnel)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Arc" & Chr(10) & "Fon"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 5
Sheets("Sprints").Range(Cells(LS + 1, NoColoneEntete), Cells(LS + 5000, NoColoneEntete)).Style = "Percent"


' Colonne J 10 (Avancement Architecture Organique)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Arc" & Chr(10) & "Org"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 5
Sheets("Sprints").Range(Cells(LS + 1, NoColoneEntete), Cells(LS + 5000, NoColoneEntete)).Style = "Percent"


' Colonne K 11 (Statut du récit - TI)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Statut" & Chr(10) & "TI"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 8
Sheets("Sprints").Columns(NoColoneEntete).HorizontalAlignment = xlCenter


'On fait un groupe avec les colonnes "TI" (5 à 11)
Sheets("Sprints").Columns("E:K").Select
Selection.Group


'Colonne L 12 Statut Aff.
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "%" & Chr(10) & "Aff."
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 4
Sheets("Sprints").Columns(NoColoneEntete).HorizontalAlignment = xlCenter
Sheets("Sprints").Range(Cells(LS + 1, NoColoneEntete), Cells(LS + 5000, NoColoneEntete)).Style = "Percent"


'Colonne M 13 Livrable Aff.
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Livrable Affaire"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 22
Sheets("Sprints").Columns(NoColoneEntete).WrapText = True


'Colonne N 14 Resp. Aff.
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Resp." & Chr(10) & "Aff."
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 7
Sheets("Sprints").Columns(NoColoneEntete).HorizontalAlignment = xlCenter
Sheets("Sprints").Columns(NoColoneEntete).WrapText = True


'Colonne O 15 Type
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Type"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 6


'Colonne P 16 Commentaire
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Commentaires"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 36
Sheets("Sprints").Columns(NoColoneEntete).WrapText = True


'On fait un groupe avec les colonnes "Affaire" (M, N, O, P)
Sheets("Sprints").Columns("M:P").Select
Selection.Group




' Colonne Q 17 (Pilote)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Pilote"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 11


' Colonne R 18 (Statut de la rédaction des cas d'essais)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Cas" & Chr(10) & "Essais"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 8


'Colonnes S à X 19 à 24 (Listes des Dossiers fonctionnels)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Dossier #1"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 24


NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Dossier #2"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 24


NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Dossier #3"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 24


NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Dossier #4"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 24


NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Dossier #5"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 24


NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Dossier #6"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 13




'On fait un groupe avec les colonnes "Pilotage" (R à X)
Sheets("Sprints").Columns("R:X").Select
Selection.Group


' Colonne Y 25 (# de la livraison)
NoColoneEntete = NoColoneEntete + 1
Sheets("Sprints").Cells(LS, NoColoneEntete).Value = "Liv"
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Bold = True
Sheets("Sprints").Cells(LS, NoColoneEntete).Font.Size = 14
Sheets("Sprints").Columns(NoColoneEntete).ColumnWidth = 4


Sheets("Sprints").Rows(LS).RowHeight = 34
LS = LS + 1


'Pour débuter au sprint 20
LS = LigneDeDebut


'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Dim ws As Range
Set ws = Sheets("Sprints").Cells ' Faire une copie de la Worksheet Sprints dans ws
Dim wru As Range
Set wru = Sheets("Récits Utilisateurs").Cells ' Faire une copie de la Worksheet Récits Utilisateurs dans wru
Dim i As Integer




For NoSprint = 20 To 30

ws.Cells(LS, 1).Value = "Sprint " & NoSprint & " - Capacité: " & Sheets("DomaineDeValeur").Cells(NoSprint + 1, 9) & "Pts"
'Mettre en forme, l'en-tête de Sprint
ws.Rows(LS).RowHeight = 26
ws(LS, 1).Font.Bold = True
ws(LS, 1).Font.Size = 20
ws.Parent.Range(Cells(LS, 1), Cells(LS, 25)).Interior.Color = RGB(125, 215, 255)
ws.Parent.Range(Cells(LS, 1), Cells(LS, 25)).Borders(xlEdgeBottom).LineStyle = xlContinuous
ws.Parent.Range(Cells(LS, 1), Cells(LS, 25)).Borders(xlEdgeTop).LineStyle = xlContinuous


PointsPlanifies = 0
LigneEnteteSprint = LS
LS = LS + 1
RecitDone = 1
' On retient le # de rangé du début du sprint (on s'en servira plus tard pour faire un grouping de rangés
LigneDebutSprint = LS

' Lire les récits utilisateurs
For LR = LigneDebutRecit To NbreDeRecits
If wru.Cells(LR, 5).Value = NoSprint And Len(wru.Cells(LR, 3).Value) > 1 Then
'On a trouvé un récit pour ce sprint
'On vérifie d'abord si c'est le premier récit de ce Thème/Épics
If THEME <> wru.Cells(LR, 22).Value Then
'C'est un nouveau récit pour ce Thème/Epic, alors on mets un en-tête
THEME = wru.Cells(LR, 22).Value
ws.Cells(LS, 2).Value = THEME
ws.Range(Cells(LS, 1), Cells(LS, 25)).Interior.Color = RGB(250, 191, 143)
ws.Rows(LS).Font.Bold = True
LS = LS + 1
End If

PointsPlanifies = PointsPlanifies + wru.Cells(LR, 7).Value

'Ensuite on insère le récit utilisateur
ws(LS, 3).Value = wru(LR, 3).Value ' Le titre du récit à insérer
ws(LS, 4).Value = wru(LR, 6).Value ' Le numéro de référence dans TFS pour le récit

ws(LS, 5).Value = wru(LR, 7).Value ' Le nbre de points du récit à insérer
ws(LS, 6).Value = wru(LR, 8).Value ' Equipe
ws(LS, 7).Value = wru(LR, 9).Value ' Analyste
ws(LS, 8).Value = wru(LR, 10).Value ' Date Kick-Off
ws(LS, 9).Value = wru(LR, 11).Value ' Avancement Arch.Fonc.
ws(LS, 10).Value = wru(LR, 12).Value ' Avancement Arch.Org.
ws(LS, 11).Value = wru(LR, 13).Value ' Le statut TI du récit

ws(LS, 12).Value = wru(LR, 14).Value ' Statut Aff.
ws(LS, 13).Value = wru(LR, 15).Value ' Livrable affaire
ws(LS, 14).Value = wru(LR, 16).Value ' Responsable
ws(LS, 15).Value = wru(LR, 17).Value ' Type
ws(LS, 16).Value = wru(LR, 18).Value ' Commentaire
For i = 1 To wru(LR, 18).Characters.Count
ws(LS, 16).Characters(i, 1).Font.Bold = wru(LR, 18).Characters(i, 1).Font.Bold
ws(LS, 16).Characters(i, 1).Font.Color = wru(LR, 18).Characters(i, 1).Font.Color
Next i

ws(LS, 17).Value = wru(LR, 19).Value ' Pilote
ws(LS, 18).Value = wru(LR, 20).Value ' CasDessai
ws(LS, 19).Value = wru(LR, 23).Value ' Dossier1
ws(LS, 20).Value = wru(LR, 24).Value ' Dossier2
ws(LS, 21).Value = wru(LR, 25).Value ' Dossier3
ws(LS, 22).Value = wru(LR, 26).Value ' Dossier4
ws(LS, 23).Value = wru(LR, 27).Value ' Dossier5
ws(LS, 24).Value = wru(LR, 28).Value ' Dossier6

ws(LS, 25).Value = wru(LR, 4).Value ' Livraison


ws.Rows(LS).AutoFit

If ws(LS, 11).Value = "Terminé TI" Then
ws.Range(Cells(LS, 1), Cells(LS, 25)).Interior.Color = RGB(192, 192, 192)
End If

If wru.Cells(LR, 13).Value <> "Terminé" And wru.Cells(LR, 13).Value <> "Terminé TI" Then
RecitDone = 0
End If

LS = LS + 1

End If


Next

'On fait un group avec toutes les rangés d'un sprint si on a au moins une rangé
If LigneDebutSprint <> LS Then
LigneFinSprint = LS - 1
ws.Range(Cells(LigneDebutSprint, 1), Cells(LigneFinSprint, 1)).EntireRow.Select
Selection.Group

'On collapse le group si tous les récits sont terminés
If RecitDone = 1 Then
' ws.Outline.ShowLevels RowLevels:=1
ws.Rows(LigneDebutSprint).ShowDetail = False
' On cache les rangées si le sprint fait partie d'une livraison terminée
If LigneDebutSprint < LigneDeDebut Then
LignesACacher = LigneDebutSprint & ":" & LigneFinSprint
ws.Rows(LignesACacher).EntireRow.Hidden = True
End If
End If

End If

If RecitDone = 1 Then
ws.Cells(LigneEnteteSprint, 1).Value = "Sprint " & NoSprint & " - Capacité: " & Sheets("DomaineDeValeur").Cells(NoSprint + 1, 9) & "Pts" & " vs Pts réalisés: " & PointsPlanifies & " / Dates: " & Format(Sheets("DomaineDeValeur").Cells(NoSprint + 1, 8), "yyyy/mm/dd") & " - " & Format(Sheets("DomaineDeValeur").Cells(NoSprint + 1, 10), "yyyy/mm/dd")
Else
ws.Cells(LigneEnteteSprint, 1).Value = "Sprint " & NoSprint & " - Capacité: " & Sheets("DomaineDeValeur").Cells(NoSprint + 1, 9) & "Pts" & " vs Pts planifiés: " & PointsPlanifies & " / Dates: " & Format(Sheets("DomaineDeValeur").Cells(NoSprint + 1, 8), "yyyy/mm/dd") & " - " & Format(Sheets("DomaineDeValeur").Cells(NoSprint + 1, 10), "yyyy/mm/dd")
End If

For Each xComment In Application.ActiveSheet.Comments
xComment.Shape.TextFrame.AutoSize = True
Next

Next




ws.Range("A:AZ").Copy Destination:=Sheets("Sprints").Range("A1")




'On cache les lignes existantes qui font partie d'une livraison précédente
LignesACacher = 2 & ":" & 645
Sheets("Sprints").Rows(LignesACacher).EntireRow.Hidden = True


'On merge les colonnes A etB
For i = 646 To LS
If Sheets("Sprints").Cells(i, 3) <> "" Then
Sheets("Sprints").Range(Cells(i, 1), Cells(i, 2)).Merge
End If
Next


Sheets("Sprints").Rows("2:2").Select
ActiveWindow.FreezePanes = True


'Permettre la modification de certaines colonnes
Sheets("Sprints").Range("A2:B5000").Locked = False
Sheets("Sprints").Range("F2:R5000").Locked = False


'Appliquer les domaines de valeurs
'Analyste Fonctionnel
Sheets("Sprints").Range("G2:G5000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DomaineDeValeur!$A$26:$A$33"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


'% avancement Conception Fonctionnel et Organique
Sheets("Sprints").Range("I2:J5000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DomaineDeValeur!$C$26:$C$31"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With


'StatutTI
Sheets("Sprints").Range("K2:K5000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DomaineDeValeur!$C$2:$C$6"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With




'% Affaire
Sheets("Sprints").Range("L2:L5000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DomaineDeValeur!$C$26:$C$31"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With




'Responsable Affaire
Sheets("Sprints").Range("N2:N5000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DomaineDeValeur!$E$38:$E$51"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With




'Type
Sheets("Sprints").Range("O2:O5000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DomaineDeValeur!$A$19:$A$22"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With




'Pilote
Sheets("Sprints").Range("Q2:Q5000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DomaineDeValeur!$A$38:$A$44"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With




'Statut cas d'essai
Sheets("Sprints").Range("R2:R5000").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=DomaineDeValeur!$C$38:$C$40"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With




Sheets("Sprints").Protect , Userinterfaceonly:=True, AllowFormattingCells:=True
Sheets("Sprints").EnableOutlining = True




Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic


Application.DisplayStatusBar = True


Application.EnableEvents = True


'ActiveSheet.DisplayPageBreaks = True

Sheets("Sprints").Cells(1, 1).Select


errHandler:
Application.ScreenUpdating = True




'End Function
End Sub

[offthelip]

Gosh, where to start!!!
There is plenty of scope for improvement, I haven't got the time at the moment. Hopefully somebody will get back or I will when I get some time.

[offthelip]

I finally got back to you,
when trying to write code that operate fast, the most important thing to understand is what are the actions that take along time. The common action that really take a long time in VBA is any action that interacts with the worksheet. e.g reading from the worksheet, writing to the worksheet , formatting the worksheet.
I have just run some test on my machine and the time taken to write a single cell to the worksheet is 0.26 seconds
The time taken to write an array of 5000 rows by 100 columns is 0.36 seconds, only very slightly longer, and certainly less time than writing separately to 2 cells.
Reading data from the worksheet will be very similar.
So to write fast vba the best thing to do is to load all of the data from all the worksheet into a series of variant arrays, run through all the calculations purely using VBA and then write all the results out to the spreadsheet. Then separately do all the formatting on the spreadsheet. Unfortunately there is no way around doing the formatting it is always going to be slow, but it is best to it in large chunks. e.g format the whole worksheet to a default format and the reformat just those bits that need to be different.

I have taken a bit of your code which was in a multiple loop and deleted all the formatting from it, and changed the range variables that you declared into variant arrays using exactly the same names. The code does compile but obviously I can't test it so I would be suprised if it worked. But I have done this to show you how I would write the code.

Equally on the formatting you have lots and lots of lines of formatting most of which are applying the same formats often in a loop. it is much faster to apply the format to a large range rather than do it a cell at a time

LS = LigneDeDebut



'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'Dim ws As Range
Dim ws As Variant
' load all the data from the worksheet in to a variant array
ws = Sheets("Sprints").UsedRange ' Faire une copie de la Worksheet Sprints dans ws


'Dim wru As Range
' load all the data from the worksheet in to a variant array
Dim wru As Variant
 wru = Sheets("Récits Utilisateurs").UsedRange ' Faire une copie de la Worksheet Récits Utilisateurs dans wru
Dim i As Integer








For nosprint = 20 To 30


ws(LS, 1) = "Sprint " & nosprint & " - Capacité: " & Sheets("DomaineDeValeur").Cells(nosprint + 1, 9) & "Pts"
'Mettre en forme, l'en-tête de Sprint
' don't do the formatting in a loop it is very slow
'ws.Rows(LS).RowHeight = 26 don't do this in a loop do the formatting separately
'ws(LS, 1).Font.Bold = True
'ws(LS, 1).Font.Size = 20
'ws.Parent.Range(Cells(LS, 1), Cells(LS, 25)).Interior.Color = RGB(125, 215, 255)
'ws.Parent.Range(Cells(LS, 1), Cells(LS, 25)).Borders(xlEdgeBottom).LineStyle = xlContinuous
'ws.Parent.Range(Cells(LS, 1), Cells(LS, 25)).Borders(xlEdgeTop).LineStyle = xlContinuous




PointsPlanifies = 0
LigneEnteteSprint = LS
LS = LS + 1
RecitDone = 1
' On retient le # de rangé du début du sprint (on s'en servira plus tard pour faire un grouping de rangés
LigneDebutSprint = LS


' Lire les récits utilisateurs
For LR = LigneDebutRecit To NbreDeRecits
If wru(LR, 5) = nosprint And Len(wru(LR, 3)) > 1 Then
'On a trouvé un récit pour ce sprint
'On vérifie d'abord si c'est le premier récit de ce Thème/Épics
If Theme <> wru(LR, 22) Then
'C'est un nouveau récit pour ce Thème/Epic, alors on mets un en-tête
Theme = wru(LR, 22)
ws(LS, 2) = Theme
'ws.Range(Cells(LS, 1), Cells(LS, 25)).Interior.Color = RGB(250, 191, 143)
'ws.Rows(LS).Font.Bold = True
LS = LS + 1
End If


PointsPlanifies = PointsPlanifies + wru(LR, 7)


'Ensuite on insère le récit utilisateur
ws(LS, 3) = wru(LR, 3) ' Le titre du récit à insérer
ws(LS, 4) = wru(LR, 6) ' Le numéro de référence dans TFS pour le récit


ws(LS, 5) = wru(LR, 7) ' Le nbre de points du récit à insérer
ws(LS, 6) = wru(LR, 8) ' Equipe
ws(LS, 7) = wru(LR, 9) ' Analyste
ws(LS, 8) = wru(LR, 10) ' Date Kick-Off
ws(LS, 9) = wru(LR, 11) ' Avancement Arch.Fonc.
ws(LS, 10) = wru(LR, 12) ' Avancement Arch.Org.
ws(LS, 11) = wru(LR, 13) ' Le statut TI du récit


ws(LS, 12) = wru(LR, 14) ' Statut Aff.
ws(LS, 13) = wru(LR, 15) ' Livrable affaire
ws(LS, 14) = wru(LR, 16) ' Responsable
ws(LS, 15) = wru(LR, 17) ' Type
ws(LS, 16) = wru(LR, 18) ' Commentaire
'do the formatting outside of the loop
'For i = 1 To wru(LR, 18).Characters.Count
'ws(LS, 16).Characters(i, 1).Font.Bold = wru(LR, 18).Characters(i, 1).Font.Bold
'ws(LS, 16).Characters(i, 1).Font.Color = wru(LR, 18).Characters(i, 1).Font.Color
'Next i


ws(LS, 17) = wru(LR, 19) ' Pilote
ws(LS, 18) = wru(LR, 20) ' CasDessai
ws(LS, 19) = wru(LR, 23) ' Dossier1
ws(LS, 20) = wru(LR, 24) ' Dossier2
ws(LS, 21) = wru(LR, 25) ' Dossier3
ws(LS, 22) = wru(LR, 26) ' Dossier4
ws(LS, 23) = wru(LR, 27) ' Dossier5
ws(LS, 24) = wru(LR, 28) ' Dossier6


ws(LS, 25) = wru(LR, 4) ' Livraison


' do thje foramtting separately
'ws.Rows(LS).AutoFit


'If ws(LS, 11) = "Terminé TI" Then
'ws.Range(Cells(LS, 1), Cells(LS, 25)).Interior.Color = RGB(192, 192, 192)
'End If


If wru(LR, 13) <> "Terminé" And wru(LR, 13) <> "Terminé TI" Then
RecitDone = 0
End If


LS = LS + 1


End If




Next
Next
' write out the variant arrays  to the worksheet


 Sheets("Sprints").UsedRange = ws
 Sheets("Récits Utilisateurs").UsedRange = wru
 ' now do the formatting and try to do it with the minimum number of loops, do it in big chunks if you can

I have just spotted that there is another worksheet that you reference in this loop :
Sheets("DomaineDeValeur").Cells(nosprint + 1, 9)
This should also be loaded into a variant array since you access it every loop so that is another 0.26 of second lost every loop
I will let you work out how to do that one.

I have just remembered another way of speeding up your code, get rid of the debug print statements . when I want to capture debug information I write it to a dummy array and write the dummy array out to a dummy spreadsheet at the end, it is then easier to see.

[PatBed]

Thanks a lot for your suggestion.
I will see what I can do, and let you know if it speeds up my Macro!