For traversing 70,000 rows (using a for
loop), my macro is taking a lot of time to give output comment as per various conditions (if
statement). Please help me improve my approach. I am working on around 70,000 rows and my code is taking a lot of time to run. Please see the attachment image that depicts how data looks.
Option Explicit
Sub Analysis()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim wsa As Worksheet
Dim l, AudLastRow, AudLastCol, NIMsLastCol, NIMsRow As Long
Dim d19, d8, d25, p19, p8, p25 As Integer
Dim ColLtr As String
Dim aPRTS, bNIMS, Deployed19, Deployed800, Deployed2500, PRTS800, PRTS1900, PRTS2500 As Variant
Set wsa = ThisWorkbook.Worksheets("Audit-NIMS vs Site Topology")
NIMsLastCol = ThisWorkbook.Sheets("NIMSCarrierCount").Cells(2, Columns.Count).End(xlToLeft).Column
NIMsRow = ThisWorkbook.Sheets("NIMS dump-SC level").Cells(Rows.Count, 2).End(xlUp).Row
With wsa
AudLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
AudLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(1, AudLastCol + 1).Value = "Match;Issue Type;Actions"
For l = 2 To AudLastRow
aPRTS = .Cells(l, AudLastCol).Value
bNIMS = .Cells(l, NIMsLastCol).Value
' tempin = .Cells(l, 2).Value
If aPRTS = bNIMS Then
Deployed19 = Application.Match("Deployed(1.9)", .Rows(1), 0)
If IsNumeric(Deployed19) Then
d19 = .Cells(l, Deployed19).Value
Else
d19 = 0
End If
Deployed800 = Application.Match("Deployed (800)", .Rows(1), 0)
If IsNumeric(Deployed800) Then
d8 = .Cells(l, Deployed800).Value
Else
d8 = 0
End If
Deployed2500 = Application.Match("Deployed (2.5)", .Rows(1), 0)
If IsNumeric(Deployed2500) Then
d25 = .Cells(l, Deployed2500).Value
Else
d25 = 0
End If
PRTS800 = Application.Match("Total-800-PRTS", .Rows(1), 0)
If IsNumeric(PRTS800) Then
p8 = .Cells(l, PRTS800).Value
Else
p8 = 0
End If
PRTS1900 = Application.Match("Total-1900-PRTS", .Rows(1), 0)
If IsNumeric(PRTS1900) Then
p19 = .Cells(l, PRTS1900).Value
Else
p19 = 0
End If
PRTS2500 = Application.Match("Total-2500-PRTS", .Rows(1), 0)
If IsNumeric(PRTS2500) Then
p25 = .Cells(l, PRTS2500).Value
Else
p25 = 0
End If
If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
.Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
Else
.Cells(l, AudLastCol + 1).Value = "FALSE;Both;Update NIMS and PRTS."
End If
ElseIf aPRTS = "NA" And bNIMS = "0" Then
.Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
ElseIf aPRTS = "0" And bNIMS = "NA" Then
.Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
ElseIf aPRTS > 0 And bNIMS = "NA" Then
.Cells(l, AudLastCol + 1).Value = "N/A;NIMS;Update NIMS."
ElseIf bNIMS > 0 And aPRTS = "NA" Then
.Cells(l, AudLastCol + 1).Value = "N/A;PRTS;Check traffic from PRTS & Report to PRTS Team."
ElseIf bNIMS > aPRTS Then
.Cells(l, AudLastCol + 1).Value = "FALSE;PRTS;Check traffic from PRTS & Report to PRTS Team."
ElseIf bNIMS < aPRTS Then
.Cells(l, AudLastCol + 1).Value = "FALSE;NIMS;Update NIMS."
End If
If InStr(1, .Cells(l, 1).Value, "52XC") > 0 Then
.Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
ElseIf InStr(1, .Cells(l, 1).Value, "82XC") > 0 Then
.Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "Clearwire Site."
ElseIf InStr(1, .Cells(l, 1).Value, "XT") > 0 Then
.Cells(l, AudLastCol + 1).Value = .Cells(l, AudLastCol + 1).Value & "COW Site."
End If
If bNIMS = "NA" And Application.CountIf(ThisWorkbook.Sheets("NIMS dump-SC level").Range("B1:B" & NIMsRow), .Cells(l, 2).Value) Then
.Cells(l, AudLastCol + 1).Value = Cells(l, AudLastCol + 1).Value & "Present in NIMS Dump."
End If
Next l
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
-
\$\begingroup\$ How do you know this snippet is the bottleneck? How long does it take right now? \$\endgroup\$RubberDuck– RubberDuck2018年07月28日 12:19:32 +00:00Commented Jul 28, 2018 at 12:19
-
\$\begingroup\$ I debugged different snippets of the code to find it out. My rest of the code which is used to develop this audit sheet from multiple workbooks takes around 10 mins and this one -analysis sheet takes 30-40 mins for 70,000 rows. \$\endgroup\$HobbyCoder– HobbyCoder2018年07月28日 12:25:16 +00:00Commented Jul 28, 2018 at 12:25
1 Answer 1
Your logic is probably the biggest factor here. Using your estimate of 70,000 rows and assuming that aPRTS
and bNIMS
are equal for all of them, then you are doing around 420,000 Match
calculations and an even greater number of accesses to cells (with all the overheads these have in comparison to array calculations).
Use of Match
From what I can work out from the convoluted logic, you are using the Match
merely to determine which columns you must compare. However, once you are in your worksheet, this column order does not change.
So, you can remove nearly half a million expensive calculations by doing this up front. For you logic, this is a good place to use a Variant
.
With wsa
AudLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
AudLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
' *** Do these next lines only once, not 70,000 times.
Deployed19 = Application.Match("Deployed(1.9)", .Rows(1), 0)
Deployed800 = Application.Match("Deployed (800)", .Rows(1), 0)
Deployed2500 = Application.Match("Deployed (2.5)", .Rows(1), 0)
PRTS1900 = Application.Match("Total-1900-PRTS", .Rows(1), 0)
PRTS800 = Application.Match("Total-800-PRTS", .Rows(1), 0)
PRTS2500 = Application.Match("Total-2500-PRTS", .Rows(1), 0)
.Cells(1, AudLastCol + 1).Value = "Match;Issue Type;Actions"
For l = 2 To AudLastRow
aPRTS = .Cells(l, AudLastCol).Value
bNIMS = .Cells(l, NIMsLastCol).Value
' tempin = .Cells(l, 2).Value
If aPRTS = bNIMS Then
If IsNumeric(Deployed19) Then
d19 = .Cells(l, Deployed19).Value
Else
d19 = 0
End If
If IsNumeric(Deployed800) Then
d8 = .Cells(l, Deployed800).Value
Else
d8 = 0
End If
If IsNumeric(Deployed2500) Then
d25 = .Cells(l, Deployed2500).Value
Else
d25 = 0
End If
If IsNumeric(PRTS800) Then
p8 = .Cells(l, PRTS800).Value
Else
p8 = 0
End If
If IsNumeric(PRTS1900) Then
p19 = .Cells(l, PRTS1900).Value
Else
p19 = 0
End If
If IsNumeric(PRTS2500) Then
p25 = .Cells(l, PRTS2500).Value
Else
p25 = 0
End If
If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
.Cells(l, AudLastCol + 1).Value = "TRUE;None;No Action Required."
Else
.Cells(l, AudLastCol + 1).Value = "FALSE;Both;Update NIMS and PRTS."
End If
'[ELSEIF] statements here.
End If
' [Other code here]
Next l
End With
I have stuck with Variant
because the Match
might return an error. I have also left the standard If-Then-Else
construct because the VBA IIF()
statement evaluates all expressions so would return and error should the desired column not exist.
Variable declaration
Your code to declare the variables is not doing what you think it should.
Dim wsa As Worksheet
Dim l, AudLastRow, AudLastCol, NIMsLastCol, NIMsRow As Long
Dim d19, d8, d25, p19, p8, p25 As Integer
Dim ColLtr As String
Dim aPRTS, bNIMS, Deployed19, Deployed800, Deployed2500, PRTS800, PRTS1900, PRTS2500 As Variant
Only NIMsRow
is Long
, p25
is Integer
, the rest are Variant
which is the default type. Each variable must be individually declared as shown below. Also, while possibly not important for your dataset, get in the habit of using Long
instead of Integer
. Memory is cheap these days!
Dim wsa As Worksheet
Dim l As Long, AudLastRow As Long, AudLastCol As Long, NIMsLastCol As Long, NIMsRow As Long
Dim d19 As Long, d8 As Long, d25 As Long, p19 As Long, p8 As Long, p25 As Long
Dim ColLtr As String
Dim aPRTS, bNIMS, Deployed19, Deployed800, Deployed2500, PRTS800, PRTS1900, PRTS2500 'As Variant
Use Arrays
It is faster to dump the data into arrays and then run through the arrays than to keep on referencing cells. Because you have blank cells in your data, you would use a Variant
type and your code would check accordingly while doing comparisons. You can put the results of the audit into another array and then simple write this array in one hit at the end of your routine.
I am not going to write sample code here. But where you do an early check for the existence of a column (your Match
functions), you can quickly create an array of 0
if it does not exist. This also simplify your If aPRTS = bNIMS Then
block because you will not need all those If-Then-Else
.
What arrays would you need?
aPRTS
andbNIMS
: replaces/fixesIf aPRTS = bNIMS Then
etcd19
andp19
: replaces/fixesIf (p19 = d19) And (p8 = d8) And (p25 = d25) Then
d8
andp8
: replaces/fixesIf (p19 = d19) And (p8 = d8) And (p25 = d25) Then
d25
andp25
: replaces/fixesIf (p19 = d19) And (p8 = d8) And (p25 = d25) Then
Name
: replaces/fixesIf InStr(1, .Cells(l, 1).Value, "52XC") > 0 Then
etcAuditResult
: What you will write into the sheet at the end. fixes/replaces.Cells(l, AudLastCol + 1).Value = "N/A;NIMS;Update NIMS."
etc.
-
\$\begingroup\$ Thanks AJD. I am not from a s/w engg background and have started learning programming 6 months back. The reason for this delay in my reply is I have been trying to understand the usage of arrays by reading about it from different sources online. I did not understand how will I not need If-Then-else statements by using arrays. The way I understand arrays usage here is:instead of referencing the cell, I'll be saving the comments in an array and at the end, I'll populate that array data in cells using a for loop. Can you please guide me with a reading source to understand arrays this way? \$\endgroup\$HobbyCoder– HobbyCoder2018年07月31日 03:20:07 +00:00Commented Jul 31, 2018 at 3:20
-
1\$\begingroup\$ @SABU: An internet search will provide many references. Something like bettersolutions.com/excel/cells-ranges/… will be easy to understand. For more indepth analysis, there is always Chip Pearson's work: cpearson.com/excel/vbaarrays.htm and cpearson.com/excel/PassingAndReturningArrays.htm . \$\endgroup\$AJD– AJD2018年07月31日 06:19:42 +00:00Commented Jul 31, 2018 at 6:19
-
\$\begingroup\$ @SABU: What I was inferring by the use of arrays is that you can create a 0-filled array if a column does not exist (which is what your
If-Then
are doing). So, if you already know the array exists and is filled with 0, you can save time and effort in the coding. But yes, otherwise you would fill the array and in the end you will use a populated array of data to fill cells. However (to your benefit), you can fill a range without using a loop - another saving on time and effort! \$\endgroup\$AJD– AJD2018年07月31日 06:23:11 +00:00Commented Jul 31, 2018 at 6:23