if/elseif soo slow; how to optimize?

[stalledräng]

Ok, I managed to create a macro that steps thorugh every row and check/insert values if certain criteras are met. But it seems like if/elseif statements are very slow (?). Is there a way to optimize this macro either by using if/elseif-statements in a more brilliant way or by using some sort of arrays?

TIA/Staffan


Sub EUCheck()
Application.ScreenUpdating = False
Application.Cursor = xlWait
Range("a2", Range("a2").End(xlDown)).Select
For Each Cell In Selection
If Cell.Offset(0, 11).Value = "SE" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "DK" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "FI" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "DE" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "AT" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "NL" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "BE" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "LU" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "FR" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "GB" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "IT" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "ES" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "PT" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "GR" Then
Cell.Offset(0, 12).Value = "EU"
ElseIf Cell.Offset(0, 11).Value = "IR" Then
Cell.Offset(0, 12).Value = "EU"
Else
End If
Next Cell
Range("a1").Select
Application.Cursor = xlDefault
Application.ScreenUpdating = True
End Sub

 

[Richie(UK)]

Hi,

Try this:

<pre>Sub EUCheck()
Dim Cell As Range
Application.ScreenUpdating = False
Application.Cursor = xlWait

For Each Cell In Range("a2", Range("a2").End(xlDown))
Select Case Cell.Offset(0, 11).Value
Case Is = "SE": Cell.Offset(0, 12).Value = "EU"
Case Is = "DK": Cell.Offset(0, 12).Value = "EU"
Case Is = "FI": Cell.Offset(0, 12).Value = "EU"
Case Is = "DE": Cell.Offset(0, 12).Value = "EU"
Case Is = "AT": Cell.Offset(0, 12).Value = "EU"
Case Is = "NL": Cell.Offset(0, 12).Value = "EU"
Case Is = "BE": Cell.Offset(0, 12).Value = "EU"
Case Is = "LU": Cell.Offset(0, 12).Value = "EU"
Case Is = "FR": Cell.Offset(0, 12).Value = "EU"
Case Is = "GB": Cell.Offset(0, 12).Value = "EU"
Case Is = "IT": Cell.Offset(0, 12).Value = "EU"
Case Is = "ES": Cell.Offset(0, 12).Value = "EU"
Case Is = "PT": Cell.Offset(0, 12).Value = "EU"
Case Is = "GR": Cell.Offset(0, 12).Value = "EU"
Case Is = "IR": Cell.Offset(0, 12).Value = "EU"
End Select
Next Cell

Application.Cursor = xlDefault
Application.ScreenUpdating = True

End Sub</pre>
HTH

 

[Andrew Poulsom]

This might be quicker:

For Each Cell In Selection 
Select Case Cell.Offset(0, 11).Text
Case "SE","DK","FI","DE","AT","NL","BE","LU","FR","GB","IT","ES","PT","GR","IR"
Cell.Offset(0, 12).Value = "EU" 
End Select
Next Cell

EDIT: missing Offset in Select Case.
This message was edited by Andrew Poulsom on 2002-11-14 07:21

 

[Richie(UK)]

Andrew - even better

 

[tusharm]

In addition to what Andrew tried, I tried a few other options.

For 65536 rows:
1) the If-ElseIf took 55 seconds on my computer.
2) the Select Case took 5 seconds.
3) the use of an XL formula together with Copy/PasteSpecial Values took 9 seconds. This has two additional advantages in that the EU test is now available to other VBA routines and also as a UDF in XL itself!
4) the use of an indexed vector took 23 seconds. I expected this to be the fastest, but I couldn't come up with a quick way to convert a string to an index value. Maybe someone can suggest a better conversion process.
5a) a collection with an error trap in the function isEUCountryUsingCollection took 23 seconds,
5b) a collection with the error trap in the calling routine took 5 seconds.

code for 2:
<pre>
Sub EUCheck2()
Dim Cell As Range
startTimer
Application.ScreenUpdating = False
Application.Cursor = xlWait
Range("a2", Range("a2").End(xlDown)).Select
For Each Cell In Selection
Select Case Cell.Offset(0, 11).Value
Case Is = "SE", "DK", "FI", "DE", "AT", "NL", _
"BE", "LU", "FR", "GB", "IT", "ES", "PT", _
"GR", "IR":
Cell.Offset(0, 12).Value = "EU"
Case Else:
End Select
Next Cell
'Range("a1").Select
Application.Cursor = xlDefault
Application.ScreenUpdating = True
endTimer "EUCheck with Select for " & Selection.Rows.Count & " rows"
End Sub
</pre>

code for 3:
<pre>
Function IsEUCountry(whatCountry As String)
Select Case whatCountry
Case Is = "SE", "DK", "FI", "DE", "AT", "NL", _
"BE", "LU", "FR", "GB", "IT", "ES", "PT", _
"GR", "IR":
IsEUCountry = True
Case Else:
End Select
End Function
Sub EUCheck3()
Dim Cell As Range
startTimer
'Application.ScreenUpdating = False
Application.Cursor = xlWait
With Range("a2", Range("a2").End(xlDown)).Offset(0, 12)
.FormulaR1C1 = _
"=IF(iseucountry(RC[-1]),""EU"","""")"
Application.Calculate
.Copy
.PasteSpecial xlPasteValues
End With
Application.Cursor = xlDefault
Application.ScreenUpdating = True
endTimer "EUCheck with XL formula for " & Selection.Rows.Count & " rows"
End Sub</pre>

code for 4:
<pre>
Dim EUList() As Boolean, EUCollection As Collection
Sub setEUVector()
Dim x As Variant, i As Integer
ReDim EUList(1 To 26 * 26)
x = Array("SE", "DK", "FI", "DE", "AT", "NL", _
"BE", "LU", "FR", "GB", "IT", "ES", "PT", _
"GR", "IR")
For i = LBound(x) To UBound(x)
EUList((Asc(Left(x(i), 1)) - Asc("A") + 1) * 26 _
+ (Asc(Right(x(i), 1)) - Asc("A") + 1)) = True
Next i
End Sub
Function isEUCountryusingVector(whatCountry As String)
If Len(whatCountry) = 2 Then _
isEUCountryusingVector = EUList((Asc(Left(whatCountry, 1)) - Asc("A") + 1) * 26 _
+ (Asc(Right(whatCountry, 1)) - Asc("A") + 1))
End Function

Sub EUCheckusingVector()
Dim Cell As Range
startTimer
setEUVector
Application.ScreenUpdating = False
Application.Cursor = xlWait
Range("a2", Range("a2").End(xlDown)).Select
For Each Cell In Selection
Cell.Offset(0, 12) = _
IIf(isEUCountryusingVector(Cell.Offset(0, 11).Value), "EU", "")
Next Cell
'Range("a1").Select
Application.Cursor = xlDefault
Application.ScreenUpdating = True
endTimer "EUCheck with vector for " & Selection.Rows.Count & " rows"
End Sub</pre>

code for 5:
<pre>
Sub setEUCollection()
Dim x As Variant, i As Integer
Set EUCollection = New Collection
x = Array("SE", "DK", "FI", "DE", "AT", "NL", _
"BE", "LU", "FR", "GB", "IT", "ES", "PT", _
"GR", "IR")
For i = LBound(x) To UBound(x)
EUCollection.Add True, x(i)
Next i
End Sub
Function isEUCountryusingCollection(whatCountry As String)
isEUCountryusingCollection = EUCollection(whatCountry)
End Function

Sub EUCheckusingCollection()
Dim Cell As Range
startTimer
setEUCollection
Application.ScreenUpdating = False
Application.Cursor = xlWait
Range("a2", Range("a2").End(xlDown)).Select
On Error Resume Next
For Each Cell In Selection
Cell.Offset(0, 12) = _
IIf(isEUCountryusingCollection(Cell.Offset(0, 11).Value), "EU", "")
Next Cell
'Range("a1").Select
Application.Cursor = xlDefault
Application.ScreenUpdating = True
endTimer "EUCheck with collection for " & Selection.Rows.Count & " rows"
End Sub
</pre>

 

[stalledräng]

Thanks for all the answers buddies!!!

This was exactly what I was looking for. Couldn't have done it without your help. I used Andrews code because it simply looked better )) (and it runs very fast indeed). No more need for the hour glass cursor... I wouldn't completely have understood it without Richies code though, so props to you.

I also would like to give a special thank you to tusharm. Very interesting reading indeed. To make your own EUcheck function in Excel? Simply amazing. It will be put into good use. I'll also use the principles for making more smart functions.

Thank you all VERY much indeed.

/Staffan