Excel VBA - Loop through tables + if statements

[trux101]

The code below works, however it is taking 8.5 seconds which in the big scheme of my whole workbook macros is ernomous.

I have two input tables and one output table - Eligibility_Tbl </SPAN> and Exclusions_Tbl which determine whether </SPAN>Eligibility columns</SPAN> on the Data_Tbl </SPAN>is set to "Eligible" or "Not Eligible" for about 60000 rows.

Firstly the macro loops the Eligibility_Tbl </SPAN>to find grades that are not eligible for a salary increase and then loops the Exclusions_Tbl to find Staff_Id for employees that should always be listed on the Data_Tbl </SPAN> Eligibility as "Not Eligible" whether or not their grade qualifies them.

E.g.Eligibility_Tbl </SPAN>- Grade 1, grade 6 and grade 8 are "Eligible" but then individuals with Staff_Id A1234 and A3234 are "Not Eligible" on the Exclusions_Tbl. The Data_Tbl </SPAN> Eligibility column will have A1234 and A3234 as "Not Eligible"

Is there a more efficient way to loop through all three tables and achieve the above reducing from the current 8.5 seconds?



Public Function Exclusions()</SPAN></SPAN>

Dim StartTime As Double, SecondsElapsed As Double</SPAN></SPAN>
StartTime = Timer</SPAN></SPAN>

Dim Staff_Id As Variant, Exclusions_Staff_Id As Variant, Eligibility_Grade As Variant</SPAN></SPAN>
Dim Data_Tbl As Variant, Grade_Cluster As Variant</SPAN></SPAN>
Dim Ln As Long, x As Long, y As Long</SPAN></SPAN>
Dim Eligibility_Tbl As Variant, Exclusions_Tbl As Variant, Eligibility As Variant</SPAN></SPAN>


Staff_Id = Range("Data_Tbl[Staff Id]")</SPAN></SPAN>
Exclusions_Staff_Id = Range("Exclusions[Staff Id]")</SPAN></SPAN>
Eligibility_Grade = Range("Grade_Elig_Tbl[Corporate Grade]")</SPAN></SPAN>
Data_Tbl = Range("Data_Tbl")</SPAN></SPAN>
Grade_Cluster = Range("Data_Tbl[Grade Cluster]")</SPAN></SPAN>
Eligibility_Tbl = Range("Grade_Elig_Tbl")</SPAN></SPAN>
Exclusions_Tbl = Range("Exclusions")</SPAN></SPAN>

ReDim Eligibility(1 To UBound(Staff_Id), 1 To 1)</SPAN></SPAN>

For Ln = 1 To UBound(Staff_Id)</SPAN></SPAN>
For y = 1 To UBound(Eligibility_Grade)</SPAN></SPAN>
For x = 1 To UBound(Exclusions_Staff_Id)</SPAN></SPAN>


If Grade_Cluster(Ln, 1) = Eligibility_Tbl(y, 1) And Eligibility_Tbl(y, 2) = "Not Eligible" Then</SPAN></SPAN>
Eligibility(Ln, 1) = "Not Eligible - Grade"</SPAN></SPAN>
ElseIf Data_Tbl(Ln, 1) = Exclusions_Tbl(x, 1) Then</SPAN></SPAN>
Eligibility(Ln, 1) = "Not Eligible - Exclusions"</SPAN></SPAN>
ElseIf Grade_Cluster(Ln, 1) = Eligibility_Tbl(y, 1) And Eligibility_Tbl(y, 2) = "Eligible" Then</SPAN></SPAN>
Eligibility(Ln, 1) = "Eligible"</SPAN></SPAN>

End If</SPAN></SPAN>


Next x</SPAN></SPAN>
Next y</SPAN></SPAN>
Next Ln</SPAN></SPAN>

Range("Data_Tbl[Salary Increment Eligibility]") = Eligibility</SPAN></SPAN>

SecondsElapsed = Round(Timer - StartTime, 2)</SPAN></SPAN>
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation</SPAN></SPAN>


End Function </SPAN></SPAN>

 

[Rhodie72]

The code below works, however it is taking 8.5 seconds which in the big scheme of my whole workbook macros is ernomous.

I have two input tables and one output table - Eligibility_Tbl and Exclusions_Tbl which determine whether Eligibility columns on the Data_Tbl is set to "Eligible" or "Not Eligible" for about 60000 rows.

Firstly the macro loops the Eligibility_Tbl to find grades that are not eligible for a salary increase and then loops the Exclusions_Tbl to find Staff_Id for employees that should always be listed on the Data_Tbl Eligibility as "Not Eligible" whether or not their grade qualifies them.

E.g.Eligibility_Tbl - Grade 1, grade 6 and grade 8 are "Eligible" but then individuals with Staff_Id A1234 and A3234 are "Not Eligible" on the Exclusions_Tbl. The Data_Tbl Eligibility column will have A1234 and A3234 as "Not Eligible"

Is there a more efficient way to loop through all three tables and achieve the above reducing from the current 8.5 seconds?

Maybe by changing the if statements and the order of the exclusions you might speed things up. By first excluding the ineligible from the equation, you short out many more lines of code so you have fewer iterations to sort through, technically. By changing the IF... THEN... ELSEIF...END IF to a SELECT CASE...CASE...END SELECT select, you can nest your equations better and remove the verbosity of the code too. Consider that the compiler has to read every letter like humans do and this takes time. Simplify your code to make it faster.

Use arrays where possible that are operated on in the code instead of referencing the ranges in a sheet. Done correctly, this code could execute in under 2 seconds.

Public Function Exclusions()
StartTime = Timer
' you never need to specify variant unless it is an array you refer to for that type _
By default, unassigned dimensions are variant type anyway
Dim StartTime As Double, SecondsElapsed As Double, _
    Staff_Id As Range, Exclusions_Staff_Id As Range, _
    Eligibility_Grade As Range, Data_Tbl As Range, _
    Grade_Cluster As Range, Ln As Long, x As Long, _
    y As Long, Eligibility_Tbl As Range, Exclusions_Tbl As Range, Eligibility

    Set Staff_Id = Range("Data_Tbl[Staff Id]")
    Set Exclusions_Staff_Id = Range("Exclusions[Staff Id]")
    Set Eligibility_Grade = Range("Grade_Elig_Tbl[Corporate Grade]")
    Set Data_Tbl = Range("Data_Tbl")
    Set Grade_Cluster = Range("Data_Tbl[Grade Cluster]")
    Set Eligibility_Tbl = Range("Grade_Elig_Tbl")
    Set Exclusions_Tbl = Range("Exclusions")

    ReDim Eligibility(1 To UBound(Staff_Id), 1 To 1)
    
    For x = 1 To UBound(Exclusions_Staff_Id)
        For Ln = 1 To UBound(Staff_Id)
            For y = 1 To UBound(Eligibility_Grade)
                gc = Grade_Cluster(Ln, 1)
                ETbl1 = Eligibility_Tbl(y, 1)
                ETbl2 = Eligibility_Tbl(y, 2)
                
                Select Case gc = ETbl1 And ETbl2
                    Case "Not Eligible"
                        Eligibility(Ln, 1) = "Not Eligible - Grade"
                        Select Case Data_Tbl(Ln, 1)
                            Case Exclusions_Tbl(x, 1)
                                Eligibility(Ln, 1) = "Not Eligible - Exclusions"
                        End Select
                    Case "Eligible"
                        Eligibility(Ln, 1) = "Eligible"
                End Select
            Next y
        Next Ln
    Next x
    
    Range("Data_Tbl[Salary Increment Eligibility]") = Eligibility
    
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Function

 

[RoryA]

                Select Case gc = ETbl1 And ETbl2
                    Case "Not Eligible"

I'm curious as to how you think that could work?

As an aside, the notion that Select Case will always be simpler, better or faster than If... Then statements intrigues me. Do you have any evidence of this? You bring it up repeatedly as a matter of fact, so I would be very interested to see the basis for it. Most programming textbooks would disagree with you. In my experience, although the differences tend to be marginal, If... Then tends to be faster.

 

[Rhodie72]

If statements get convoluted with ong strings of code and multiple data results. When the strings are shortened and simplified fro reading by using Select case statements then it becomes easier to understand as humans. The compiler doesn't always see a difference in the result but I have noticed that the selct case statemetns are faster with multiple answers than multiple if statements trying to achieve the same result.

As an example:

    If this = that Or somethingelse Then
            do this and this
            and this too
        ElseIf this = somethingelse Then
            do something else
        ElseIf this = Not that And Not somethingelse Then
            Exit Sub
    End If

'Whereas a Select case argument would be simpler as in:

    Select Case this or somethingelse
        Case that And that
            do this and this
            and this too
        Case somethingelse
            do something else
        Case Not that And Not somethingelse
            Exit Sub
    End If

the argument being that fewer characters are being comp[iled and therefore less time consumed to process the code... means faster. It also may mean a lower memory overhead for RAM and therefore less impact on the time for data execution in more severe cases (considering that some data will almost always be written to drive cache instead of RAM).

 

[RoryA]

I was actually looking for empirical data, rather than theory or pseudocode. It is certainly not correct to suggest that Select Case is always better than If..End If, or vice versa.

Also, you didn't address my question about the Select Case statement you suggested.