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
 
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

L
  • Question Question
VBA macro problem
Replies
2
Views
179
Joe4
Joe4
R
  • Question Question
Required Transposed Values instead of Row Items of Duplicate Invoice no with Each GSTIN which is displaying the SUM of 12+18+28
Replies
1
Views
118
rk_rk
R
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
445
tixarah
T
R
  • Question Question
VBA to automate calculation
Replies
1
Views
222
HighAndWilder
H
O
  • Solved
VBA Code to Find Duplicate Values in a Range and Add a Number at the End
2
Replies
12
Views
1K
OilEconomist
O

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