Make the code crisper to enhance performance

T

tariq_kamal

New Member
Joined
Sep 8, 2010
Messages
11
Dear all,

below is the code that i am using to analyze some data. The code is taking around 2.2 minutes to run. Being a report for senior management this is too long. Please suggest ways so that it runs faster.

Code: 
Option Explicit
Dim rw As Long
Dim i As Integer
Dim count As Integer
 
Sub Summary()
Dim j As Integer
Dim ud As Long
Dim dd As Long
Dim dd1 As Long
Dim dd2 As Long
Dim dd3 As Long
Application.ScreenUpdating = False

Sheets("Tracing").Range(Cells(42, 2), Cells(53, 4)).Value = ""
Sheets("Tracing").Range(Cells(57, 2), Cells(68, 4)).Value = ""
Sheets("Tracing").Range(Cells(72, 2), Cells(83, 4)).Value = ""
count = Sheets("lockdown").Cells(1, 13).Value
Worksheets("Lockdown").Activate
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Assigned games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

For j = 42 To 53
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count
dd = Sheets("Lockdown").Cells(i, 19).Value
If DateDiff("m", ud, dd) = 0 Then
Sheets("Tracing").Cells(j, 2).Value = Sheets("Tracing").Cells(j, 2).Value + 1
End If
Next i
Next j
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Returned games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'*********************************************************
'Definition of variables and setting values for variables
'*********************************************************
For j = 42 To 53
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 23).Value
dd1 = Sheets("lockdown").Cells(i, 26).Value
dd2 = Sheets("Lockdown").Cells(i, 29).Value
dd3 = Sheets("Lockdown").Cells(i, 32).Value
'***************************************************************************************
'Check if game is not completed if only one cycle then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'***************************************************************************************
'Check if game is not completed if only two cycles then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'***************************************************************************************
'Check if game is not completed if only three cycles then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'*********************************************************************************
'Check if game is not completed if four cycles then return date for specific month
'*********************************************************************************
If Cells(i, 9).Value <> "Completed" And DateDiff("m", ud, dd3) = 0 Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'**************************************************************************
'Missed logic - If game is completed then pick data for its returned cycles
'**************************************************************************
If (Cells(i, 9).Value = "Completed") And (DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
If (Cells(i, 9).Value = "Completed") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
If (Cells(i, 9).Value = "Completed") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else

End If
End If
End If
End If
End If
End If
End If
Next i
Next j
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Completed games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'*********************************************************
'Definition of variables and setting values for variables
'*********************************************************
For j = 42 To 53
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 14).Value
'********************************************************************************
'Check if game is completed if only one cycle then return date for specific month
'********************************************************************************
If Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd) = 0 Then
Sheets("Tracing").Cells(j, 4).Value = Sheets("Tracing").Cells(j, 4).Value + 1
End If
Next i
Next j

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Assigned MGL/Port games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

For j = 57 To 68
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 19).Value
If DateDiff("m", ud, dd) = 0 And (Cells(i, 17).Value <> "TA") Then
Sheets("Tracing").Cells(j, 2).Value = Sheets("Tracing").Cells(j, 2).Value + 1
End If
Next i
Next j
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Returned games MGL/Port for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'*********************************************************
'Definition of variables and setting values for variables
'*********************************************************
For j = 57 To 68
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 23).Value
dd1 = Sheets("lockdown").Cells(i, 26).Value
dd2 = Sheets("Lockdown").Cells(i, 29).Value
dd3 = Sheets("Lockdown").Cells(i, 32).Value
'***************************************************************************************
'Check if game is not completed if only one cycle then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value <> "TA") And (DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'***************************************************************************************
'Check if game is not completed if only two cycles then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value <> "TA") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'***************************************************************************************
'Check if game is not completed if only three cycles then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value <> "TA") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'*********************************************************************************
'Check if game is not completed if four cycles then return date for specific month
'*********************************************************************************
If Cells(i, 9).Value <> "Completed" And (Cells(i, 17).Value <> "TA") And DateDiff("m", ud, dd2) = 0 Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'**************************************************************************
'Missed logic - If game is completed then pick data for its returned cycles
'**************************************************************************
If (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value <> "TA") And (DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
If (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value <> "TA") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
If (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value <> "TA") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else

End If
End If
End If
End If
End If
End If
End If
Next i
Next j
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Completed MGL/Port games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'*********************************************************
'Definition of variables and setting values for variables
'*********************************************************
For j = 57 To 68
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 14).Value
'********************************************************************************
'Check if game is completed if only one cycle then return date for specific month
'********************************************************************************
If Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd) = 0 And (Cells(i, 17).Value <> "TA") Then
Sheets("Tracing").Cells(j, 4).Value = Sheets("Tracing").Cells(j, 4).Value + 1
End If
Next i
Next j
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Assigned TA games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

For j = 72 To 83
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 19).Value
If DateDiff("m", ud, dd) = 0 And (Cells(i, 17).Value = "TA") Then
Sheets("Tracing").Cells(j, 2).Value = Sheets("Tracing").Cells(j, 2).Value + 1
End If
Next i
Next j

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Returned games TA for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'*********************************************************
'Definition of variables and setting values for variables
'*********************************************************
For j = 72 To 83
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 23).Value
dd1 = Sheets("lockdown").Cells(i, 26).Value
dd2 = Sheets("Lockdown").Cells(i, 29).Value
dd3 = Sheets("Lockdown").Cells(i, 32).Value
'***************************************************************************************
'Check if game is not completed if only one cycle then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'***************************************************************************************
'Check if game is not completed if only two cycles then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'***************************************************************************************
'Check if game is not completed if only three cycles then return date for specific month
'***************************************************************************************
If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value = "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'*********************************************************************************
'Check if game is not completed if four cycles then return date for specific month
'*********************************************************************************
If Cells(i, 9).Value <> "Completed" And (Cells(i, 17).Value = "TA") And DateDiff("m", ud, dd2) = 0 Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
'**************************************************************************
'Missed logic - If game is completed then pick data for its returned cycles
'**************************************************************************
If (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
If (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
If (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value <> "") Then
Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
Else
End If
End If
End If
End If
End If
End If
End If
Next i
Next j
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Completed TA games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'*********************************************************
'Definition of variables and setting values for variables
'*********************************************************
For j = 72 To 83
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 14).Value
'********************************************************************************
'Check if game is completed if only one cycle then return date for specific month
'********************************************************************************
If Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd) = 0 And (Cells(i, 17).Value = "TA") Then
Sheets("Tracing").Cells(j, 4).Value = Sheets("Tracing").Cells(j, 4).Value + 1
End If
Next i
Next j

Application.ScreenUpdating = True
End Sub
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
you have turned off screen updating, try also setting the calculation to manual at the start and turning it to automatic at the end

'
'****
' next turn off the calculations to speed up things
'****
'

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


your code here

'
'****
' turn back on the calculations and finish
'****
'

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 
Upvote 0
Hi,
I did try to that also but it was like a difference of 2-3 seconds only. I think the way i have written the code needs to be changed but 'coz i have learnt VBA by myself so i ain't too good at it. So if you can help in maybe optimizing the way the code has been written..that might change things...
 
Upvote 0
Seems like you have some redundant loops. The first loop goes through this range:

Code: 
For j = 42 To 53
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count
dd = Sheets("Lockdown").Cells(i, 19).Value

and checks for this condition:

Code: 
If DateDiff("m", ud, dd) = 0 Then
Sheets("Tracing").Cells(j, 2).Value = Sheets("Tracing").Cells(j, 2).Value + 1
End If

second loop goes through:
Code: 
For j = 42 To 53
ud = Sheets("tracing").Cells(j, 1).Value
For i = 4 To count

dd = Sheets("Lockdown").Cells(i, 23).Value
dd1 = Sheets("lockdown").Cells(i, 26).Value
dd2 = Sheets("Lockdown").Cells(i, 29).Value
dd3 = Sheets("Lockdown").Cells(i, 32).Value

and does a bunch of IF checks.

Make a dd4 variable and make it equal Sheets("Lockdown").Cells(i, 19).Value and include the if statement in that long list of ifs. You can cut down on several loops by consolidating as much of the looping as possible.

The IF statement could start with something like this:

Code: 
If DateDiff("m", ud, dd) = 0 Then
     Sheets("Tracing").Cells(j, 2).Value = Sheets("Tracing").Cells(j, 2).Value + 1
          If (Cells(i, 9).Value <> "Completed") And Cells(i, 26).Value = "" Then   Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
          If (Cells(i, 9).Value <> "Completed") And Cells(i, 29).Value = "" Then Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
          More ifs
          More ifs
          More ifs
End if
 
Upvote 0
hold on. Started looking a bit closer and I may be off. Let me fumble around and see what I can come up with.
 
Upvote 0
Ok, see if this is any faster. Complete shot in the dark so please try it on a copy of your workbook before your only version:

Code: 
Option Explicit
Dim rw As Long
Dim i As Integer
Dim count As Integer
 
Sub Summary()
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim ud As Long
Dim ud1 As Long
Dim dd As Long
Dim dd1 As Long
Dim dd2 As Long
Dim dd3 As Long
Dim dd4 As Long
Dim dd5 As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Tracing").Range(Cells(42, 2), Cells(53, 4)).Value = ""
Sheets("Tracing").Range(Cells(57, 2), Cells(68, 4)).Value = ""
Sheets("Tracing").Range(Cells(72, 2), Cells(83, 4)).Value = ""
count = Sheets("lockdown").Cells(1, 13).Value
Worksheets("Lockdown").Activate

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Returned games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'*********************************************************
'Definition of variables and setting values for variables
'*********************************************************
k = 57 ' 2nd loop
l = 72 ' 3rd loop
For j = 42 To 53
    ud = Sheets("tracing").Cells(j, 1).Value
    ud1 = Sheets("tracing").Cells(k, 1).Value
        For i = 4 To count
            dd = Sheets("Lockdown").Cells(i, 23).Value
            dd1 = Sheets("lockdown").Cells(i, 26).Value
            dd2 = Sheets("Lockdown").Cells(i, 29).Value
            dd3 = Sheets("Lockdown").Cells(i, 32).Value
            dd4 = Sheets("Lockdown").Cells(i, 19).Value
            dd5 = Sheets("Lockdown").Cells(i, 14).Value
'********************************************************************************
'Check if game is completed if only one cycle then return date for specific month
'********************************************************************************
            If Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd5) = 0 Then
                Sheets("Tracing").Cells(j, 4).Value = Sheets("Tracing").Cells(j, 4).Value + 1
            End If
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Assigned games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            If DateDiff("m", ud, dd4) = 0 Then
                Sheets("Tracing").Cells(j, 2).Value = Sheets("Tracing").Cells(j, 2).Value + 1
            End If
'***************************************************************************************
'Check if game is not completed if only one cycle then return date for specific month
'***************************************************************************************
            If Cells(i, 9).Value <> "Completed" And DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value = "" Or Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd = 0) And Cells(i, 26).Value <> "" Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If
'***************************************************************************************
'Check if game is not completed if only two cycles then return date for specific month
'***************************************************************************************
            If (Cells(i, 9).Value <> "Completed") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value = "") Or Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value <> "" Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If
'***************************************************************************************
'Check if game is not completed if only three cycles then return date for specific month
'***************************************************************************************
            If (Cells(i, 9).Value <> "Completed") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value = "") Or Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value <> "" Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If
'*********************************************************************************
'Check if game is not completed if four cycles then return date for specific month
'*********************************************************************************
            If Cells(i, 9).Value <> "Completed" And DateDiff("m", ud, dd3) = 0 Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If
' 2nd part (old loop from 57 to 68)
            If DateDiff("m", ud1, dd4) = 0 And (Cells(i, 17).Value <> "TA") Then
                Sheets("Tracing").Cells(k, 2).Value = Sheets("Tracing").Cells(k, 2).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value = "" Or Cells(i, 9).Value = "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value <> "" Then
                Sheets("Tracing").Cells(k, 3).Value = Sheets("Tracing").Cells(k, 3).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value = "" Or Cells(i, 9).Value = "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value <> "" Then
                Sheets("Tracing").Cells(k, 3).Value = Sheets("Tracing").Cells(k, 3).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value = "" Or Cells(i, 9).Value = "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value <> "" Then
                Sheets("Tracing").Cells(k, 3).Value = Sheets("Tracing").Cells(k, 3).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And (Cells(i, 17).Value <> "TA") And DateDiff("m", ud, dd2) = 0 Then
                Sheets("Tracing").Cells(k, 3).Value = Sheets("Tracing").Cells(k, 3).Value + 1
            End If
            If Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd5) = 0 And (Cells(i, 17).Value <> "TA") Then
                Sheets("Tracing").Cells(k, 4).Value = Sheets("Tracing").Cells(j, 4).Value + 1
            End If
' old 3rd loop (72 to 83)
            If DateDiff("m", ud, dd4) = 0 And (Cells(i, 17).Value = "TA") Then
                Sheets("Tracing").Cells(l, 2).Value = Sheets("Tracing").Cells(l, 2).Value + 1
            End If
            If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value = "") Or (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value <> "") Then
                Sheets("Tracing").Cells(l, 3).Value = Sheets("Tracing").Cells(l, 3).Value + 1
            End If
            If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value = "") Or (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value <> "") Then
                Sheets("Tracing").Cells(l, 3).Value = Sheets("Tracing").Cells(l, 3).Value + 1
            End If
            If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value = "") Or (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value <> "") Then
                Sheets("Tracing").Cells(l, 3).Value = Sheets("Tracing").Cells(l, 3).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And (Cells(i, 17).Value = "TA") And DateDiff("m", ud, dd2) = 0 Then
                Sheets("Tracing").Cells(l, 3).Value = Sheets("Tracing").Cells(l, 3).Value + 1
            End If
            If Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd5) = 0 And (Cells(i, 17).Value = "TA") Then
                Sheets("Tracing").Cells(l, 4).Value = Sheets("Tracing").Cells(l, 4).Value + 1
            End If
        Next i
k = k + 1
l = l + 1
Next j

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Post back and let me know if it's any faster (or at least returns the correct results).
 
Upvote 0
Eeek, quick correction:

Code: 
Option Explicit
Dim rw As Long
Dim i As Integer
Dim count As Integer
 
Sub Summary()
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim ud As Long
Dim ud1 As Long
Dim ud2 As Long
Dim dd As Long
Dim dd1 As Long
Dim dd2 As Long
Dim dd3 As Long
Dim dd4 As Long
Dim dd5 As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Tracing").Range(Cells(42, 2), Cells(53, 4)).Value = ""
Sheets("Tracing").Range(Cells(57, 2), Cells(68, 4)).Value = ""
Sheets("Tracing").Range(Cells(72, 2), Cells(83, 4)).Value = ""
count = Sheets("lockdown").Cells(1, 13).Value
Worksheets("Lockdown").Activate

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Returned games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'*********************************************************
'Definition of variables and setting values for variables
'*********************************************************
k = 57 ' 2nd loop
l = 72 ' 3rd loop
For j = 42 To 53
    ud = Sheets("tracing").Cells(j, 1).Value
    ud1 = Sheets("tracing").Cells(k, 1).Value
    ud2 = Sheets("tracing").Cells(l, 1).Value

        For i = 4 To count
            dd = Sheets("Lockdown").Cells(i, 23).Value
            dd1 = Sheets("lockdown").Cells(i, 26).Value
            dd2 = Sheets("Lockdown").Cells(i, 29).Value
            dd3 = Sheets("Lockdown").Cells(i, 32).Value
            dd4 = Sheets("Lockdown").Cells(i, 19).Value
            dd5 = Sheets("Lockdown").Cells(i, 14).Value
'********************************************************************************
'Check if game is completed if only one cycle then return date for specific month
'********************************************************************************
            If Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd5) = 0 Then
                Sheets("Tracing").Cells(j, 4).Value = Sheets("Tracing").Cells(j, 4).Value + 1
            End If
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Create summary for Assigned games for all months
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            If DateDiff("m", ud, dd4) = 0 Then
                Sheets("Tracing").Cells(j, 2).Value = Sheets("Tracing").Cells(j, 2).Value + 1
            End If
'***************************************************************************************
'Check if game is not completed if only one cycle then return date for specific month
'***************************************************************************************
            If Cells(i, 9).Value <> "Completed" And DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value = "" Or Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd = 0) And Cells(i, 26).Value <> "" Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If
'***************************************************************************************
'Check if game is not completed if only two cycles then return date for specific month
'***************************************************************************************
            If (Cells(i, 9).Value <> "Completed") And (DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value = "") Or Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd1) = 0 And Cells(i, 29).Value <> "" Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If
'***************************************************************************************
'Check if game is not completed if only three cycles then return date for specific month
'***************************************************************************************
            If (Cells(i, 9).Value <> "Completed") And (DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value = "") Or Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd2) = 0 And Cells(i, 32).Value <> "" Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If
'*********************************************************************************
'Check if game is not completed if four cycles then return date for specific month
'*********************************************************************************
            If Cells(i, 9).Value <> "Completed" And DateDiff("m", ud, dd3) = 0 Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If
' 2nd part (old loop from 57 to 68)
            If DateDiff("m", ud1, dd4) = 0 And (Cells(i, 17).Value <> "TA") Then
                Sheets("Tracing").Cells(k, 2).Value = Sheets("Tracing").Cells(k, 2).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud1, dd) = 0 And Cells(i, 26).Value = "" Or Cells(i, 9).Value = "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud1, dd) = 0 And Cells(i, 26).Value <> "" Then
                Sheets("Tracing").Cells(k, 3).Value = Sheets("Tracing").Cells(k, 3).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud1, dd1) = 0 And Cells(i, 29).Value = "" Or Cells(i, 9).Value = "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud1, dd1) = 0 And Cells(i, 29).Value <> "" Then
                Sheets("Tracing").Cells(k, 3).Value = Sheets("Tracing").Cells(k, 3).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud1, dd2) = 0 And Cells(i, 32).Value = "" Or Cells(i, 9).Value = "Completed" And Cells(i, 17).Value <> "TA" And DateDiff("m", ud1, dd2) = 0 And Cells(i, 32).Value <> "" Then
                Sheets("Tracing").Cells(k, 3).Value = Sheets("Tracing").Cells(k, 3).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And (Cells(i, 17).Value <> "TA") And DateDiff("m", ud1, dd2) = 0 Then
                Sheets("Tracing").Cells(k, 3).Value = Sheets("Tracing").Cells(k, 3).Value + 1
            End If
            If Cells(i, 9).Value = "Completed" And DateDiff("m", ud1, dd5) = 0 And (Cells(i, 17).Value <> "TA") Then
                Sheets("Tracing").Cells(k, 4).Value = Sheets("Tracing").Cells(j, 4).Value + 1
            End If
' old 3rd loop (72 to 83)
            If DateDiff("m", ud2, dd4) = 0 And (Cells(i, 17).Value = "TA") Then
                Sheets("Tracing").Cells(l, 2).Value = Sheets("Tracing").Cells(l, 2).Value + 1
            End If
            If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud2, dd) = 0 And Cells(i, 26).Value = "") Or (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud2, dd) = 0 And Cells(i, 26).Value <> "") Then
                Sheets("Tracing").Cells(l, 3).Value = Sheets("Tracing").Cells(l, 3).Value + 1
            End If
            If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud2, dd1) = 0 And Cells(i, 29).Value = "") Or (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud2, dd1) = 0 And Cells(i, 29).Value <> "") Then
                Sheets("Tracing").Cells(l, 3).Value = Sheets("Tracing").Cells(l, 3).Value + 1
            End If
            If (Cells(i, 9).Value <> "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud2, dd2) = 0 And Cells(i, 32).Value = "") Or (Cells(i, 9).Value = "Completed") And (Cells(i, 17).Value = "TA") And (DateDiff("m", ud2, dd2) = 0 And Cells(i, 32).Value <> "") Then
                Sheets("Tracing").Cells(l, 3).Value = Sheets("Tracing").Cells(l, 3).Value + 1
            End If
            If Cells(i, 9).Value <> "Completed" And (Cells(i, 17).Value = "TA") And DateDiff("m", ud2, dd3) = 0 Then ' check original code, this was dd2 in your post
                Sheets("Tracing").Cells(l, 3).Value = Sheets("Tracing").Cells(l, 3).Value + 1
            End If
            If Cells(i, 9).Value = "Completed" And DateDiff("m", ud3, dd5) = 0 And (Cells(i, 17).Value = "TA") Then
                Sheets("Tracing").Cells(l, 4).Value = Sheets("Tracing").Cells(l, 4).Value + 1
            End If
        Next i
k = k + 1
l = l + 1
Next j

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
Hi, There are a few problems
1) everytime i am running the macro excel goes to "not responding" state in the "fourth loop" for "j"
2) on debugging it gave the following error
- runtime error '-2147417848 (80010108)
Method 'value' of object 'Range' failed
This error is coming in the follwoing line of code

Code: 
'***************************************************************************************
'Check if game is not completed if only one cycle then return date for specific month
'***************************************************************************************
            If Cells(i, 9).Value <> "Completed" And DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value = "" Or Cells(i, 9).Value = "Completed" And DateDiff("m", ud, dd) = 0 And Cells(i, 26).Value <> "" Then
                Sheets("Tracing").Cells(j, 3).Value = Sheets("Tracing").Cells(j, 3).Value + 1
            End If

Exact line is ""Sheets("tracing").cells.......
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Need help modify to pick any first number of my choice
Replies
6
Views
258
motilulla
M
L
  • Question
Copy data from the previous upper line and paste to current row
Replies
0
Views
151
Linda Lo
L
E
  • Question
Estimating Spreadsheet-Summing
Replies
1
Views
131
Peter_SSs
Peter_SSs
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
359
sspatriots
S
E
  • Solved
Summing Values
Replies
3
Views
206
LazyBug
LazyBug

Forum statistics

Threads
1,214,653
Messages
6,120,750
Members
448,989
Latest member
mariah3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top