Loops vs. Arrays

[BravesPiano5]

Hello,

I'm looking for a faster way to execute the below code; it works exactly like I want it to (as far as execution) but the length of time it takes to finish is quite lengthy as the data usually at least 100K+ rows.

I've cleaned up and tried to reduce as much unnecessary code as possible...I haven't used arrays before so I researched a bit and tried it out but after a couple of tests, I don't see any performance gain with my coding. Any tips (thanks in advance!)? :*)

**Note=>

Enable events, screen updating & display alerts are turned off at the start.
LastRow is the variable declared to represent the last row# data appears in within the sheet
FundLookup & ProdLookup range variables are declared before this loop





For NumRows = 8 To LastRow
'Start loop at row# 8 as that's where table begins

Application.StatusBar = "Formulating resolution date and product info; currently @ row#" & NumRows & "..."
'Give update to user

Select Case Cells(NumRows, 13)
Case "ZCBF": Cells(NumRows, 14) = "Fund"
Case "ZCBP": Cells(NumRows, 14) = "Promotion"
Case Else: Cells(NumRows, 14) = "#"
End Select
'Identify type of transaction

If Cells(NumRows, 25) = "#" Then
Cells(NumRows, 30) = Cells(NumRows, 26)
Else
Cells(NumRows, 30) = Cells(NumRows, 25)
End If
'Formula for Resolution Date


On Error Resume Next
If Cells(NumRows, 19) = "#" Then
Cells(NumRows, 27) = WorksheetFunction.VLookup(Cells(NumRows, 22), ProdLookup, 2, 0)
Cells(NumRows, 28) = "#"
Cells(NumRows, 29) = "#"
If Cells(NumRows, 27) = "" Then Cells(NumRows, 27) = "#"
Else
Cells(NumRows, 27) = WorksheetFunction.VLookup(Cells(NumRows, 19), FundLookup, 3, 0)
Cells(NumRows, 28) = WorksheetFunction.VLookup(Cells(NumRows, 19), FundLookup, 7, 0)
Cells(NumRows, 29) = WorksheetFunction.VLookup(Cells(NumRows, 19), FundLookup, 4, 0)
If Cells(NumRows, 27) = "" Then Cells(NumRows, 27) = "#"
If Cells(NumRows, 28) = "" Then Cells(NumRows, 28) = "#"
If Cells(NumRows, 29) = "" Then Cells(NumRows, 29) = "#"
End If
'If item has a fund ID, grab the appropriate segment & category...if not, look up segment by brand
On Error GoTo 0
Next

[Kenneth Hobs]

Did you set manual calculation as well? I put those sorts of thing in: http://vbaexpress.com/kb/getarticle.php?kb_id=1035

[SamT]

:dunno: Try this

This version of user updating cuts up to 99,990 screen updates out of the loop.

"With Rows(Numrows) should work, but you might need a dot in front of each "Cells()"

Dim Decimond As Long
Dim PerCenton As Long
'
'
'

'Set Up User Update
' Note "\"
Decimond = LastRow \ 10
PerCenton = 1
Application.StatusBar = "Formulating resolution date and product info."

For NumRows = 8 To LastRow
'Start loop at row# 8 as that's where table begins

With Rows(NumRows)

'Identify type of transaction
Select Case Cells(13)
Case "ZCBF": Cells(14) = "Fund"
Case "ZCBP": Cells(14) = "Promotion"
Case Else: Cells(14) = "#"
End Select

'Formula for Resolution Date
If Cells(25) = "#" Then
Cells(30) = Cells(26)
Else
Cells(30) = Cells(25)
End If

On Error Resume Next
'If item has a fund ID, grab the appropriate segment & category...if not, look up segment by brand
If Cells(19) = "#" Then
Cells(27) = WorksheetFunction.VLookup(Cells(22), ProdLookup, 2, 0)
Cells(28) = "#"
Cells(29) = "#"
If Cells(27) = "" Then Cells(27) = "#"
Else
Cells(27) = WorksheetFunction.VLookup(Cells(19), FundLookup, 3, 0)
Cells(28) = WorksheetFunction.VLookup(Cells(19), FundLookup, 7, 0)
Cells(29) = WorksheetFunction.VLookup(Cells(19), FundLookup, 4, 0)
If Cells(27) = "" Then Cells(27) = "#"
If Cells(28) = "" Then Cells(28) = "#"
If Cells(29) = "" Then Cells(29) = "#"
End If
On Error GoTo 0

'Give update to user. Don't show "100%" complete
If NumRows Mod Decimond = 0 Then
If PerCenton < 10 Then Application.StatusBar = "Formulating resolution date and product info; " & PerCenton * 10 & "% Complete."
PerCenton = PerCenton + 1
End If
End With
Next

'Clear User Updates
Application.StatusBar = ""

[snb]

It would be nice if you showed the contents of range 'prodvlookup' and 'fundlookup'.

If you use arrays the code will be much faster:


Sub M_snb()
sn=cells(8,1).currentregion.columns("M:AD")

for j=1 to ubound(sn)
sn(j,2)=iif(sn(j,1)="ZCBF","Fund",iif(sn(j,1)="ZCBP",Promotion","#"))
sn(j,17)=sn(j,26+(sn(j,25)="#")
sn(j,14)=iif(sn(j,6)="#",application.VLookup(sn(j,9), ProdLookup, 2, 0),application.VLookup(sn(j,6), fundLookup, 3, 0))
if sn(j,6)<>"#" then sn(j,15)=application.VLookup(sn(j,6), fundLookup, 7, 0)
if sn(j,6)<>"#" then sn(j,16)=application.VLookup(sn(j,6), fundLookup, 4, 0)
if sn(j,14)="" then sn(j,14)="#"
if sn(j,15)="" then sn(j,14)="#"
if sn(j,16)="" then sn(j,14)="#"
Next

cells(8,1).currentregion.columns("M:AD")=sn
End sub

[shrivallabha]

If you are looking for speed then likes of application.statusbar should not be there.


Public Sub CheckSpeed()
t = Timer
strMsg = Application.StatusBar
For i = 1 To 100000
Application.StatusBar = i '21 seconds
'Application.StatusBar = i takes 0.015 seconds
Next i
Application.StatusBar = strMsg
Debug.Print Timer - t
End Sub

It takes 21 seconds to execute when it is updating status bar and 0.015625 seconds if commented out

[Paul_Hossler]

It might be faster to move as much code out of the loop as possible and let Excel do the heavy lifting

1. Copy an entire column, and use replace on the entire column
2. use array formulas and then copy/paste special values

Some fragments, but if you post a SMALL workbook, it's be easier to suggest




Option Explicit
Dim ProdLookup As Range, FundLookup As Range
Sub JustGuessingHere()
Dim NumRows As Long, LastRow As Long
Dim mCalc As XlCalculation
Dim bEvents As Boolean, bScreen As Boolean
Dim vStatus As Variant
Dim ws As Worksheet
Dim rData As Range, rRow As Range
Dim sFormula As String
'remember startup state
With Application
mCalc = .Calculation
bEvents = .EnableEvents
bScreen = .ScreenUpdating
vStatus = .StatusBar

'turn off for speed
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
.StatusBar = "Formulating resolution date and product info"
End With

'configure
LastRow = 40 ' test, but a SMALL WB would be nice

Set ws = ActiveSheet
Set rData = Range(ws.Cells(8, 1), ws.Cells(LastRow, 30)) ' used for test


'part 1
Call rData.Columns(13).Copy(rData.Columns(14))
Call rData.Columns(14).Replace("ZCBF", "Fund")
Call rData.Columns(14).Replace("ZCBP", "Promotion")

On Error Resume Next
rData.Columns(14).SpecialCells(xlCellTypeBlanks).Value = "#"
On Error GoTo 0

'part2
sFormula = "=IF("
sFormula = sFormula & rData.Columns(25).Address(True, True, xlR1C1) & "=""#""" & ","
sFormula = sFormula & rData.Columns(26).Address(True, True, xlR1C1) & ","
sFormula = sFormula & rData.Columns(25).Address(True, True, xlR1C1) & ")"

rData.Columns(30).FormulaArray = sFormula
rData.Columns(30).Calculate
rData.Columns(30).Copy
rData.Cells(1, 30).Select
Selection.PasteSpecial (xlValues)

'leave in the same config as we started
With Application
.Calculation = mCalc
.EnableEvents = bEvents
.ScreenUpdating = bScreen
.StatusBar = False
End With

MsgBox "All Done"
End Sub



Since I don't have much insight into your data, I made some assumptions

Paul