if/elseif soo slow; how to optimize?

stalledräng

New Member
Joined
Nov 11, 2002
Messages
4
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
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

Richie(UK)

MrExcel MVP
Joined
May 17, 2002
Messages
3,329
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

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
This might be quicker:

Code:
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
 

tusharm

MrExcel MVP
Joined
May 28, 2002
Messages
11,028
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

New Member
Joined
Nov 11, 2002
Messages
4
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,525
Messages
5,602,177
Members
414,510
Latest member
mande358

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
Top