1
\$\begingroup\$

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.

enter image description here

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
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked Jul 27, 2018 at 15:46
\$\endgroup\$
2
  • \$\begingroup\$ How do you know this snippet is the bottleneck? How long does it take right now? \$\endgroup\$ Commented 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\$ Commented Jul 28, 2018 at 12:25

1 Answer 1

2
\$\begingroup\$

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 and bNIMS: replaces/fixes If aPRTS = bNIMS Then etc
  • d19 and p19: replaces/fixes If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
  • d8 and p8: replaces/fixes If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
  • d25 and p25: replaces/fixes If (p19 = d19) And (p8 = d8) And (p25 = d25) Then
  • Name: replaces/fixes If InStr(1, .Cells(l, 1).Value, "52XC") > 0 Then etc
  • AuditResult: What you will write into the sheet at the end. fixes/replaces .Cells(l, AudLastCol + 1).Value = "N/A;NIMS;Update NIMS." etc.
answered Jul 28, 2018 at 21:31
\$\endgroup\$
3
  • \$\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\$ Commented 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\$ Commented 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\$ Commented Jul 31, 2018 at 6:23

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.