How to speed up this macro? How to use an array?

[djvino]

Hello everybody,

I am trying to speed my macro a little bit, and I figured out that I can use array. But it's not working. Where is the issue?




Sheets("Source data LPD0" & LPD).Select

ArrayA = Range("A3:AT5000").Value

For Lrow = 4997 To 3 Step -1

PRange = 0.15 'If PV is higher or lower than SP by PRange*SP macro deletes the entry.


For Lcol = 3 To 45 Step 3

If ArrayA(Lrow, Lcol) = "#NA" Or ArrayA(Lrow, Lcol) = "NORecords" Then Range(ArrayA(Lrow, Lcol - 1), ArrayA(Lrow, Lcol + 1)) = ""
If ArrayA(Lrow, Lcol) < 0.01 Or ArrayA(Lrow, Lcol) = "Null" Then Range(ArrayA(Lrow, Lcol - 1), ArrayA(Lrow, Lcol + 1)) = ""
If ArrayA(Lrow, Lcol - 1) < 0.01 Or ArrayA(Lrow, Lcol - 1) = "Null" Then Range(ArrayA(Lrow, Lcol - 1), ArrayA(Lrow, Lcol + 1)) = ""
If ArrayA(Lrow, Lcol + 1) < 5 Or ArrayA(Lrow, Lcol + 1) = "Null" Then Range(ArrayA(Lrow, Lcol - 1), ArrayA(Lrow, Lcol + 1)) = ""

SP_MIN = ArrayA(Lrow, Lcol).Value * (1 - PRange)
SP_MAX = ArrayA(Lrow, Lcol).Value * (1 + PRange)

If ArrayA(Lrow, Lcol - 1) < SP_MIN Or ArrayA(Lrow, Lcol - 1) > SP_MAX Then Range(ArrayA(Lrow, Lcol - 1), ArrayA(Lrow, Lcol + 1)) = ""

Next Lcol
Next Lrow

Range("A3:AT5000").Value = ArrayA



The code without array is working OK, but very slow - 90 seconds:



Sheets("Source data LPD0" & LPD).Select

For Lrow = 5000 To 3 Step -1

'---------------------------------------------------------------------------------------
PRange = 0.15 'If PV is higher or lower than SP by PRange*SP macro deletes the entry.
'---------------------------------------------------------------------------------------

For Lcol = 3 To 45 Step 3

Set PV_Cell = Cells(Lrow, Lcol - 1)
Set SP_Cell = Cells(Lrow, Lcol)
Set CV_Cell = Cells(Lrow, Lcol + 1)

If SP_Cell = "#NA" Or SP_Cell = "NORecords" Then Range(PV_Cell, CV_Cell).ClearContents
If SP_Cell < 0.01 Or SP_Cell = "Null" Then Range(PV_Cell, CV_Cell).ClearContents
If PV_Cell < 0.01 Or PV_Cell = "Null" Then Range(PV_Cell, CV_Cell).ClearContents
If CV_Cell < 5 Or CV_Cell = "Null" Then Range(PV_Cell, CV_Cell).ClearContents

SP_MIN = SP_Cell * (1 - PRange)
SP_MAX = SP_Cell * (1 + PRange)

If PV_Cell < SP_MIN Or PV_Cell > SP_MAX Then Range(PV_Cell, CV_Cell).ClearContents

Next Lcol
Next Lrow


Thanks for any help!

Mario

[Bob Phillips]

Post your workbook to play with.

[Kenneth Hobs]

In your first routine, as you write or clear data, screen updates and calculation occur. To speedup those sorts of things by disabling for a bit, use the macro in this article. http://vbaexpress.com/kb/getarticle.php?kb_id=1035

[djvino]

Here goes the whole code:

The macro without array is working ok but 90 sec. When I use an array I got type mismatch error. When put On Error Resume next command, the macro delete all data and returns empty cells.


Option Explicit
Sub Upda()

Dim Lrow As Integer
Dim LPD, Lcol, Ans As Byte
Dim SP_MIN, SP_MAX, PRange As Double
Dim WS As Worksheet
Dim ArrayA() As Variant

On Error Resume Next

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With '----------------------------------------------------------------------------------------------------------

For Each WS In Worksheets
WS.Visible = True
Next

Sheets("Source data LPD0" & LPD).Select

ArrayA = Range("A3:AT5000").Value

For Lrow = UBound(ArrayA, 1) To LBound(ArrayA, 1) Step -1 '--------------------------------------------------------------------------------------- PRange = 0.15 '--------------------------------------------------------------------------------------- For Lcol = 3 To 45 Step 3

If ArrayA(Lrow, Lcol) = "#NA" Or ArrayA(Lrow, Lcol) = "NORecords" Then ArrayA(Lrow, Lcol - 1) = "" And ArrayA(Lrow, Lcol) = "" And ArrayA(Lrow, Lcol + 1) = ""

If ArrayA(Lrow, Lcol) < 0.01 Or ArrayA(Lrow, Lcol) = "Null" Then ArrayA(Lrow, Lcol - 1) = "" And ArrayA(Lrow, Lcol) = "" And ArrayA(Lrow, Lcol + 1) = ""

If ArrayA(Lrow, Lcol - 1) < 0.01 Or ArrayA(Lrow, Lcol - 1) = "Null" Then ArrayA(Lrow, Lcol - 1) = "" And ArrayA(Lrow, Lcol) = "" And ArrayA(Lrow, Lcol + 1) = ""

If ArrayA(Lrow, Lcol + 1) < 5 Or ArrayA(Lrow, Lcol + 1) = "Null" Then ArrayA(Lrow, Lcol - 1) = "" And ArrayA(Lrow, Lcol) = "" And ArrayA(Lrow, Lcol + 1) = ""

SP_MIN = ArrayA(Lrow, Lcol) * (1 - PRange)
SP_MAX = ArrayA(Lrow, Lcol) * (1 + PRange)

If ArrayA(Lrow, Lcol - 1) < SP_MIN Or ArrayA(Lrow, Lcol - 1) > SP_MAX Then ArrayA(Lrow, Lcol - 1) = "" And ArrayA(Lrow, Lcol) = "" And ArrayA(Lrow, Lcol + 1) = ""

Next Lcol

Next Lrow

Range("A3:AT5000").Value = ArrayA

ActiveWorkbook.Save

'-------------------------------------------------------------------------------------------- For Each WS In Worksheets WS.Visible = False Next Sheets("R").Visible = True '--------------------------------------------------------------------------------------------

With Application
.ScreenUpdating = True
.Calculation = xlNormal
.EnableEvents = True
End With

Sheets("R").Select
End If
End Sub

In this selected range I have mostly numbers. Sometimes I have text like : "#NA", "NoRecords" etc.

I cannot share the file :)
Private stuff.

THX

[Bob Phillips]

It's the data we need, so the workbook.

[Paul_Hossler]

Some thoughts ...

1. Dim LPD, Lcol, Ans As Byte -- LPD will be typed as a Variant

Dim LPD as Long, Lcol as Long, Ans As Byte

2. Why is Ans a Byte?

3. Sheets("Source data LPD0" & LPD).Select -- I don't see LPD ever set to anything

4. You have Next Lcol but there's no For ... to go with it, (commented out)

5. In your If / Then's I really don't think you mean to use the 'And' the way you are


If ArrayA(Lrow, Lcol) = "#NA" Or ArrayA(Lrow, Lcol) = "NORecords" Then ArrayA(Lrow, Lcol - 1) = "" And ArrayA(Lrow, Lcol) = "" And ArrayA(Lrow, Lcol + 1) = ""


6. Without a before and after workbook example, and going by the code fragments in the post, I'm just guessing, but something you might want to look at


For Lrow = UBound(ArrayA, 1) To LBound(ArrayA, 1) Step -1

PRange = 0.15

For Lcol = 3 To 45 Step 3

Select Case ArrayA(Lrow, Lcol)

Case "#NA", "NORecords", Is < 0.01, "Null"
ArrayA(Lrow, Lcol - 1) = Null
ArrayA(Lrow, Lcol) = Null
ArrayA(Lrow, Lcol + 1) = Null

Case Else
If ArrayA(Lrow, Lcol - 1) < 0.01 Or ArrayA(Lrow, Lcol - 1) = "Null" Then
ArrayA(Lrow, Lcol - 1) = Null
ArrayA(Lrow, Lcol) = Null
ArrayA(Lrow, Lcol + 1) = Null

ElseIf ArrayA(Lrow, Lcol + 1) < 5 Or ArrayA(Lrow, Lcol + 1) = "Null" Then
ArrayA(Lrow, Lcol - 1) = Null
ArrayA(Lrow, Lcol) = Null
ArrayA(Lrow, Lcol + 1) = Null
End If '--------------------------------------- Seems to be missing

End Select

SP_MIN = ArrayA(Lrow, Lcol) * (1 - PRange)
SP_MAX = ArrayA(Lrow, Lcol) * (1 + PRange)

If ArrayA(Lrow, Lcol - 1) < SP_MIN Or ArrayA(Lrow, Lcol - 1) > SP_MAX Then
ArrayA(Lrow, Lcol - 1) = Null
ArrayA(Lrow, Lcol) = Null
ArrayA(Lrow, Lcol + 1) = Null
End If
Next Lcol

Next Lrow


Paul

[Paul_Hossler]

Also, in your 90 second sub, in addition to Ken's suggestions

unless you really have 5000 rows, you could find the last used row and only go that far, instead of starting at 5000


Dim iLastRow As Long

Sheets("Source data LPD0" & LPD).Select

iLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 3).End(xlUp).Row

For Lrow = iLastRow To 3 Step -1



Personally, I would prefer your original since it seems more maintainable and easier to follow in my opinion



Paul

[snb]

sub snb
sn=Sheets("Source data LPD0" & LPD).Range("A3").currentregion

For j=1 to ubound(sn)
For jj = 3 To 45 Step 3
if sn(j,jj) = "#NA" Or sn(j, jj) = "NORecords" or sn(j,jj)<0.001 or sn(j,jj)= "Null" or sn(j,jj)<5 or sn(j,jj-1)< sn(j,jj)*(1-PRange) or sn(j,jj-1)>sn(j,jj)*(1+PRange) Then
sn(j, jj - 1) = ""
sn(j,jj) = ""
sn(j,jj+1) = ""
end if
Next
Next

Sheets("Source data LPD0" & LPD).Range("A3").currentregion=sn
end sub

[Tinbendr]

Cross posted.
http://www.mrexcel.com/forum/showthread.php?p=3154614#post3154614

It is considered rude to multi-post without providing a link.

[djvino]

SOLVED

THX for your inputs!

Sorry for cross posting....

Have a nice day :)

P.S.

I have decreased the time from 90 sec to 3 sec.