Question on For Next Loop speed

P

powercell99

Board Regular
Joined
May 14, 2014
Messages
75
I've been using for next loops to check a range of cells on each row using if statements with each if statement referring to a specific column cell on that row (ie: if cells(RowNum, 2).value = "No" Then cnReports.cells(NextRow, 5).value = "user entered No", And Each column on that row i check for a different condition ( column B checks for "No", column checks for a different condition. Then based on the results of the If then, a list is made on a reports sheet with each column discrepancy found.

There about 15 different columns i need to check and use the If Thens for, and depending on how large the report is, that could take a long time to run. Is there a faster method for checking cells for conditions, then listing certain cell values on that row to another sheet describing the if/then condition that was met. Seems to me that if there are 10,000 rows, it would have to do the loop 10,000 times and may be causing it to take a while.

Any suggestions/recommendations/tips would be greatly appreciated.

Thanks
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Show us the script your using and we can see if we have another way to do things.
 
Upvote 0
Beaten 2it
 
Last edited:
Upvote 0
Thanks. Its a little messy, but any suggestions on how to improve it would be really helpful.

HTML: 
Sub RunReport()
 
Application.ScreenUpdating = False
Dim LastRowAGG As Long
Dim LastRowACQ As Long
Dim RowNum As Long
Dim LastRowRpt As Long
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
cnReport.Activate
    Range("A2:G" & LastRowRpt&).Select
        Selection.ClearContents
 
cnAggregated.Activate
 
LastRowAGG = cnAggregated.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
Dim PONum As String
Dim Requestor As String
Dim System As Long
Dim Receipt As Long
Dim Vendor As String
Dim DtRcvEntNBS As Date
Dim DtRcptGoodsSvsNBS As Date
Dim DtInvNBS As Date
Dim ICIS As String
Dim ICISEmailSent As String
Dim DtICISEmailReq As Date
Dim ActualDtRecptFmReq As Date
Dim DtReqRespondICIS As Date
Dim SufficientResp As String
Dim DtEmailReqGlobRecToEnterRec As Date
Dim ProofRecptFmReq As String
Dim LineItemsEntRec As String
Dim LineAmount As String
Dim FullPartRec As String
Dim PriorPdRec As String
Dim ActualRecDateLB27 As Date
Dim DtEmailICISIndRecGlobRec As Date
Dim ConfEmail As String
Dim SubstDocs As String
Dim EmailtoGR As String
Dim LB27Complete As String
Dim EmailComplete As String
Dim Notes As String
Dim Receiver As String
 
 
 
 
For RowNum = 5 To LastRowAGG
 
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
PONum = cnAggregated.Cells(RowNum, 1)
Requestor = cnAggregated.Cells(RowNum, 2)
System = cnAggregated.Cells(RowNum, 3)
Receipt = cnAggregated.Cells(RowNum, 4)
Vendor = cnAggregated.Cells(RowNum, 5)
DtRcvEntNBS = cnAggregated.Cells(RowNum, 6)
DtRcptGoodsSvsNBS = cnAggregated.Cells(RowNum, 7)
DtInvNBS = cnAggregated.Cells(RowNum, 8)
ICIS = cnAggregated.Cells(RowNum, 9)
ICISEmailSent = cnAggregated.Cells(RowNum, 10)
DtICISEmailReq = cnAggregated.Cells(RowNum, 11)
ActualDtRecptFmReq = cnAggregated.Cells(RowNum, 12)
DtReqRespondICIS = cnAggregated.Cells(RowNum, 13)
SufficientResp = cnAggregated.Cells(RowNum, 14)
DtEmailReqGlobRecToEnterRec = cnAggregated.Cells(RowNum, 15)
ProofRecptFmReq = cnAggregated.Cells(RowNum, 16)
LineItemsEntRec = cnAggregated.Cells(RowNum, 17)
LineAmount = cnAggregated.Cells(RowNum, 18)
FullPartRec = cnAggregated.Cells(RowNum, 19)
PriorPdRec = cnAggregated.Cells(RowNum, 20)
ActualRecDateLB27 = cnAggregated.Cells(RowNum, 21)
DtEmailICISIndRecGlobRec = cnAggregated.Cells(RowNum, 22)
ConfEmail = cnAggregated.Cells(RowNum, 23)
SubstDocs = cnAggregated.Cells(RowNum, 24)
EmailtoGR = cnAggregated.Cells(RowNum, 25)
LB27Complete = cnAggregated.Cells(RowNum, 26)
EmailComplete = cnAggregated.Cells(RowNum, 27)
Notes = cnAggregated.Cells(RowNum, 28)
Receiver = cnAggregated.Cells(RowNum, 29)
 
 
 
If ICISEmailSent = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = System
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing ICIS Email to Requestor/End User"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If SufficientResp = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Insufficient Proof of Receipt"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If ProofRecptFmReq = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "No Proof of Receipt of Goods/Service from Requestor"
        cnReport.Cells(LastRowRpt, 7).Value = "Global Receiver"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If LineItemsEntRec = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing Line Item Information"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If LineAmount = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing Line Item Amounts"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If FullPartRec = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing Indication of Full/Partial Receiving"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If PriorPdRec = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing Indication of Prior Year Receiving"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If ConfEmail = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing Confirmation Email from Requestor"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If SubstDocs = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing Substantiating Document for Receipt of Goods/Services"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
       
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If EmailtoGR = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing Email to Global Receiver to Enter Receiving"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If LB27Complete = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Incomplete LB27"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If EmailComplete = "No" Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Missing Email to ICIS of Completed Receiving"
        cnReport.Cells(LastRowRpt, 7) = "ICIS"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If cnAggregated.Cells(RowNum, 7).Value <> cnAggregated.Cells(RowNum, 12).Value Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "Date of Recpt in NBS Doesn't Match Actual Date of Recpt of Goods/Svs"
        cnReport.Cells(LastRowRpt, 7) = "Receiver"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
 
If cnAggregated.Cells(RowNum, 15).Value <> cnAggregated.Cells(RowNum, 22).Value And cnAggregated.Cells(RowNum, 15).Value < cnAggregated.Cells(RowNum, 22).Value And (cnAggregated.Cells(RowNum, 22).Value - cnAggregated.Cells(RowNum, 15).Value) > 1 Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "ICIS Email to GR / GS Response Timeliness"
        cnReport.Cells(LastRowRpt, 7) = "Receiver"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
If cnAggregated.Cells(RowNum, 15).Value <> cnAggregated.Cells(RowNum, 22).Value And cnAggregated.Cells(RowNum, 15).Value > cnAggregated.Cells(RowNum, 22).Value And (cnAggregated.Cells(RowNum, 15).Value - cnAggregated.Cells(RowNum, 22).Value) > 1 Then
        cnReport.Cells(LastRowRpt, 1).Value = Receiver
        cnReport.Cells(LastRowRpt, 2).Value = Requestor
        cnReport.Cells(LastRowRpt, 3).Value = SYSTEM
        cnReport.Cells(LastRowRpt, 4).Value = Receipt
        cnReport.Cells(LastRowRpt, 5).Value = Vendor
        cnReport.Cells(LastRowRpt, 6) = "ICIS Email to GR / GS Response Timeliness"
        cnReport.Cells(LastRowRpt, 7) = "Receiver"
        Else
        End If
LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
 
 
 
Next RowNum
 
Upvote 0
Hi,

copy the whole range of data to an array

Ar = Range("A1:Z10000")

and do all loops in the array. To copy the result back

Range("A1").resize(ubound(ar), ubound(ar,2)) = Ar

regards
 
Upvote 0
Why do you think having so many Ifs will slow things down?
 
Upvote 0
Thanks for everyones help. I put the data into an array but it was still taking about 4 minutes to run the macro. I noticed that my line added 1 row to the last row was constantly requiring excel to refer back to the actual worksheet after each If/then and on each row. LastRowRpt = cnReport.Cells.Find("*", After:=Range(Cells(Rows.Count, Columns.Count), Cells(Rows.Count, Columns.Count)), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

So i just added the additional row to the variable so excel can keep track or the next row in memory instead of actually referring back to the worksheet. LastRowRpt = LastRowRpt +1

Now it take about 20 seconds to run. Really appreciate the suggestions on how best to approach a solution! :) Thanks


 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Do Until loop nested in For loop, How advance to the "Next x" in the For Loop
Replies
4
Views
255
CephasOz
CephasOz
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
290
Gajendran Yadhav
G
Skybluekid
  • Solved
Check to Table columns for Criteria VBA
Replies
4
Views
96
Skybluekid
Skybluekid
D
  • Solved
Macro that won't run Trying to use DoWhile Loop and Offset to compare cells
Replies
8
Views
211
Micron
M
K
  • Question
Conditional Formating - Dynamic "not between"
Replies
3
Views
255
dreid1011
dreid1011

Forum statistics

Threads
1,214,985
Messages
6,122,607
Members
449,090
Latest member
vivek chauhan

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