Efficient VBA If statements

kingofaces

Board Regular
Joined
Aug 23, 2010
Messages
68
The following code is for degree-day calculation if anyone is familiar with it:

Code:
Function SinDD(Min1, Min2, Max, Base, Ceiling) As Double
'GDD Formulas from Allen 1976


Dim Taverage As Double
Dim W As Double
Dim PTheta1 As Double
Dim PTheta2 As Double
Dim Min As Double
Dim SinhalfDD As Double
Dim n As Integer


For n = 1 To 2
Select Case n
Case Is = 1
Min = Min1
Case Is = 2
Min = Min2
End Select

Taverage = (Max + Min) / 2

W = (Max - Min) / 2

If W = 0 And Max < Base Then
SinDD = 0
ElseIf W = 0 And Max > Ceiling Then
SinDD = 0.5 * (Ceiling - Base)
ElseIf W = 0 And Max <= Ceiling And Max >= Base Then
SinDD = 0.5 * (Taverage - Base)
ElseIf Abs(W) > 0 Then


PTheta1 = (Base - Taverage) / W
PTheta2 = (Ceiling - Taverage) / W

  If Abs(PTheta1) < 1 Then
    Theta1 = Atn(PTheta1 / Sqr(Abs(1 - PTheta1 ^ 2)))
    ElseIf PTheta1 >= 1 Then
    Theta1 = Application.WorksheetFunction.Pi() / 2
    ElseIf PTheta1 <= -1 Then
    Theta1 = -1 * (Application.WorksheetFunction.Pi() / 2)
  End If

  If Abs(PTheta2) < 1 Then
    Theta2 = Atn(PTheta2 / Sqr(Abs(1 - PTheta2 ^ 2)))
    ElseIf PTheta2 >= 1 Then
    Theta2 = Application.WorksheetFunction.Pi() / 2
    ElseIf PTheta2 <= -1 Then
    Theta2 = -1 * (Application.WorksheetFunction.Pi() / 2)
  End If



If Max < Base Then
Sinhalf = 0

ElseIf Max > Ceiling And Min > Ceiling Then
Sinhalf = 0.5 * (Ceiling - Base)

ElseIf Max < Ceiling And Min > Base Then
Sinhalf = 0.5 * (Taverage - Base)

ElseIf Max < Ceiling And Min <= Base Then
Sinhalf = ((1 / (2 * WorksheetFunction.Pi()))) * ((W * Cos(Theta1)) + ((Taverage - Base) * ((WorksheetFunction.Pi() / 2) - Theta1)))


ElseIf Max >= Ceiling And Min > Base And Min < Ceiling Then
Sinhalf = (1 / (2 * WorksheetFunction.Pi())) * ((Taverage - Base) * (Theta2 + (WorksheetFunction.Pi() / 2)) + (Ceiling - Base) * ((Application.WorksheetFunction.Pi() / 2) - Theta2) - W * Cos(Theta2))

ElseIf Max >= Ceiling And Min <= Base Then
Sinhalf = (1 / (2 * WorksheetFunction.Pi())) * ((Taverage - Base) * (Theta2 - Theta1) + W * (Cos(Theta1) - Cos(Theta2)) + (Ceiling - Base) * ((WorksheetFunction.Pi() / 2) - Theta2))

End If

End If
SinDD = SinDD + Sinhalf
Next n

End Function

My issue is that this calculation is being repeated about 40,000 times, and seems a bit slow on some older computers I use it on. I'm wondering if the ElseIf statement can drag down calculation times and if another If or Select statement would be more efficient?
 
Last edited:

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
I've heard that select is generally slower than if in VBA.

I wonder if creating a variable for pi() might help at all, then using that variable instead of using worksheetfunction.pi() so many times...
 
Upvote 0
I forgot about Pi, but that did help a bit. It ran about 5% faster after changing it to a variable. I tried changing the only select statement to an equivalent if but that was actually 1% slower than if I kept the original select statement. I'm sure that all depends on how many options are present and how often they are used though. I had always been told select was faster than if, but that's all just word of mouth based on select examples too.

Thanks though. I think I'm just going to call it as being fast enough for the time being.
 
Upvote 0
I forgot about Pi, but that did help a bit. It ran about 5% faster after changing it to a variable. I tried changing the only select statement to an equivalent if but that was actually 1% slower than if I kept the original select statement. I'm sure that all depends on how many options are present and how often they are used though. I had always been told select was faster than if, but that's all just word of mouth based on select examples too.

Thanks though. I think I'm just going to call it as being fast enough for the time being.

Hi, there's virtually a negligible difference between Select Case and If statements because they basically have the same mechanism but different syntax.

As for the optimization of the code, see if you can reduce any mathematical expressions.

Moreover, are you sure it's this code that is slowing your code down? because it is a function and you might have other codes that slow the program down, not the function.

Lastly, removing any worksheetfunction.PI() would definitely speed up ur macro. for example, pi = 3.1415....
 
Upvote 0
Yeah, I've narrowed it done to being this function. Basically the larger macro uses one of two functions, with the code above being one of them. The other method is shorter and less complicated, but is also about 4 times quicker. I wouldn't expect for the code provided here to take that much longer. The bulk of it could be angle calculations here that aren't present in the other function, but I was mainly curious if there was anything else to clean up. I think I'm pretty content with it now after reviewing it.
 
Upvote 0
There isn't much to clean up because it's just mainly calculation.
As you've mentioned, you're using an old computer which may be the biggest problem. haha.

It probably isn't going to change anything but
try adding
Code:
DoEvents
At the very top of the function (still inside the function tho..)

It's just my curiousity :P
Could you please come back after running it?
 
Upvote 0
No significant change with the DoEvents statement. Unfortunately my work computer is slower than my home computer, but I think I've got it to a point where its a decent speed. Thanks all.
 
Upvote 0
I tried to to improve the speed (don't know if this code is relevant to what you are doing). Also, if you can substitute the double data types for long data types, it should improve speed even more.


Option Explicit
Public Type GDDDataStructure
Taverage As Double
W As Double
PTheta1 As Double
PTheta2 As Double
Theta1 As Double
Theta2 As Double
Min As Double
SinhalfDD As Double
N As Long
TempPI As Double
Min1 As Double
Min2 As Double
Max As Double
Base As Double
Ceiling As Double
Sinhalf As Double
Double1 As Double
Double2 As Double
Double3 As Double
Double4 As Double
Double5 As Double
Double6 As Double
Double7 As Double
Double8 As Double
Double9 As Double
SinDDValue As Double
Long1 As Long
Timer1 As Double
VBM As VbMsgBoxResult
Iterations As Long
End Type
Public GDD As GDDDataStructure
Sub IterateTheSinDDFunction()
GDD.TempPI = Application.WorksheetFunction.Pi()
With GDD
1 On Error Resume Next
.Iterations = InputBox("Enter the number of iterations you which to iterate.", "Iteration Entry")
If Err.Number = 6 Then
On Error GoTo 0
.VBM = MsgBox("Long datatype overflow." & vbNewLine & vbNewLine & _
"Do you wish to continue?", vbYesNo, "Continue?")
If .VBM = vbYes Then GoTo 1 Else Exit Sub
End If
If Err <> 0 Or .Iterations <= 0 Then
On Error GoTo 0
.VBM = MsgBox("Bad Input." & vbNewLine & vbNewLine & _
"Do you wish to continue?", vbYesNo, "Continue?")
If .VBM = vbYes Then GoTo 1 Else Exit Sub
End If
On Error GoTo 0
.Timer1 = Timer
For .Long1 = 0 To .Iterations
SinDD
Next .Long1
MsgBox "Runtime for " & .Long1 - 1 & " iterations: " & _
Round(Timer - .Timer1, 3) & " seconds.", vbOKOnly, "Runtime"
End With
End Sub
Function SinDD() As Long
'GDD Formulas from Allen 1976
With GDD
For .N = 1 To 2
If .N = 1 Then
.Min = .Min1
Else
.Min = .Min2
End If

.Taverage = (.Max + .Min) / 2

.W = (.Max - .Min) / 2

If .W = 0 And .Max < .Base Then
.SinDDValue = 0
ElseIf .W = 0 And .Max > .Ceiling Then
.SinDDValue = 0.5 * (.Ceiling - .Base)
ElseIf .W = 0 And .Max <= .Ceiling And .Max >= .Base Then
.SinDDValue = 0.5 * (.Taverage - .Base)
ElseIf Abs(.W) > 0 Then


.PTheta1 = (.Base - .Taverage) / .W
.PTheta2 = (.Ceiling - .Taverage) / .W

If Abs(.PTheta1) < 1 Then

.Double1 = Abs(1 - .PTheta1 ^ 2)
.Double2 = Sqr(.Double1)
.Double3 = .PTheta1 / .Double2
.Theta1 = Atn(.Double3)

ElseIf .PTheta1 >= 1 Then
.Theta1 = .TempPI / 2
ElseIf .PTheta1 <= -1 Then
.Theta1 = -1 * (.TempPI / 2)
End If

If Abs(.PTheta2) < 1 Then

.Double1 = Abs(1 - .PTheta2 ^ 2)
.Double2 = Sqr(.Double1)
.Double3 = .PTheta2 / .Double2
.Theta2 = Atn(.Double3)

ElseIf .PTheta2 >= 1 Then
.Theta2 = .TempPI / 2
ElseIf .PTheta2 <= -1 Then
.Theta2 = -1 * (.TempPI / 2)
End If

If .Max < .Base Then
.Sinhalf = 0

ElseIf .Max > .Ceiling And .Min > .Ceiling Then
.Sinhalf = 0.5 * (.Ceiling - .Base)

ElseIf .Max < .Ceiling And .Min > .Base Then
.Sinhalf = 0.5 * (.Taverage - .Base)

ElseIf .Max < .Ceiling And .Min <= .Base Then
'my experience has been the simpler the math, the faster, i.e., the less function calls
'on the same line, the faster
.Double1 = 1 / (2 * .TempPI)
.Double2 = Cos(.Theta1)
.Double2 = .W * .Double2
.Double3 = .Taverage - .Base
.Double4 = .TempPI / 2
.Double5 = .Double4 - .Theta1
.Double6 = .Double3 * .Double5
.Double7 = .Double2 + .Double6
.Sinhalf = .Double1 * .Double7


ElseIf .Max >= .Ceiling And .Min > .Base And .Min < .Ceiling Then

.Double1 = 1 / (2 * .TempPI)
.Double2 = .Taverage - .Base
.Double3 = .Theta2
.Double3 = .Double3 + .TempPI / 2
.Double4 = .Ceiling - .Base
.Double5 = .TempPI / 2
.Double5 = .Double5 - .Theta2
.Double6 = Cos(.Theta2)
.Double7 = .Double2 * .Double3 + .Double4 * .Double5 - .W * .Double6
.Sinhalf = .Double1 * .Double7

ElseIf .Max >= .Ceiling And .Min <= .Base Then

.Double1 = 1 / (2 * .TempPI)
.Double2 = .Taverage - .Base
.Double3 = .Theta2 - .Theta1
.Double4 = Cos(.Theta1)
.Double5 = Cos(.Theta2)
.Double6 = .Ceiling - .Base
.Double7 = .TempPI / 2 - .Theta2
.Double8 = .Double4 - .Double5
.Double9 = .Double2 * .Double3 + .W * .Double8 + .Double6 * .Double7
.Sinhalf = .Double1 * .Double9

End If

End If
.SinDDValue = .SinDDValue + .Sinhalf
Next .N
End With
End Function
 
Upvote 0

Forum statistics

Threads
1,224,584
Messages
6,179,687
Members
452,938
Latest member
babeneker

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