Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Efficient ways to execute code based on multiple optional criteria (Excel VBA)

Tags:

excel

vba

Is there a more efficient way to handle code execution based on multiple criteria than what I've written below? For three criteria you have potentially nine alternative results and it will scale exponentially with every new criteria added.

I've got code that has six separate criteria where you could either use one or all of them to achieve the wanted result. Using the below method of checking which criteria have been chosen forces the creation of 36 separate blocks of code and makes it a pain to add new ones.

I'm having a complete creative block with this particular project and cannot for the life of me figure out a more efficient way of doing it that will be easier to scale should additional criteria be warranted further down the line.

I would appreciate any help anyone could give. I can post the actual code but I'm more interested in a general solution so that I'm able to implement it in other projects in future as opposed to solving one specific problem.

It doesn't need to be "IsEmpty" and could be substituted with any Boolean or, for that matter, strings, ints or any other case result.

Select Case IsEmpty(x) & IsEmpty(y) & IsEmpty(z)

    Case Is = True & True & True

        'do stuff

    Case Is = False & True & True

        'do stuff

    Case Is = True & False & True

        'do stuff

    Case Is = True & True & False

        'do stuff

    Case is = False & False & True

        'do stuff

End Select

Thanks in advance!

Edit:

Since writing the above question I've continued to try and solve the problem I was having of exponentially increasing if statements. I came up with the below approach which works fairly well and thought I'd share in case anyone else was having a similar problem.

Instead of having an if statement for each potential outcome I created an array that gets fed with names corresponding to each parameter's function name. Then I call each of those functions every loop. That way, if I want to add new parameters I can just add another function.

If I had six parameters that would equate to 36 if statements to account for every potential search outcome. With this method I only need six short functions.

I'm sure there are millions of improvements I could make to the code to make it run faster but it works well for avoiding combinatorial explosion when dealing with multiple parameters.

    Public Sub SearchStuff()

    Dim book As Workbook
    Dim shResult As Worksheet
    Dim shSource As Worksheet

    Set book = ThisWorkbook
    Set shResult = book.Worksheets("Sheet1")
    Set shSource = book.Worksheets("Sheet2")

    shResult.EnableCalculation = False

    'Parameters avaiable to search with
    Dim param1 As Range
    Dim param2 As Range
    Dim param3 As Range
    Set param1 = shResult.Range("A1")
    Set param2 = shResult.Range("A2")
    Set param3 = shResult.Range("A3")       

    'Boolean expressions of whether or not the above parameters are being used
    Dim isUsedParam1 As Boolean
    Dim isUsedParam2 As Boolean
    Dim isUsedParam3 As Boolean
    isUsedParam1 = Not IsEmpty(param1)
    isUsedParam2 = Not IsEmpty(param2)
    isUsedParam3 = Not IsEmpty(param3)

    Dim lastSearchRow As Long
    lastSearchRow = shSource.Cells(Rows.Count, "A").End(xlUp).Row

    Dim rngSearch As Range
    Set rngSearch = shSource.Range("A2:A" & lastSearchRow)

    Dim lastRow As Long
    Dim rngOutput As Range
    Dim rngToCopy As Range
    Dim noSearchCriteriaProvided As Boolean

    Dim firstSectionToCopy As Range
    Dim secondSectionToCopy As Range
    Dim thirdSectionToCopy As Range

    Dim loopingCell As Range
    For Each loopingCell In rngSearch

        If noSearchCriteriaProvided = True Then

            MsgBox "No search criteria provided." & vbNewLine & vbNewLine & "Please select at least one criteria to search for and try again.", , "Whoopsie!"

            Exit Sub

        End If

        lastRow = shResult.Cells(Rows.Count, "B").End(xlUp).Row
        Set rngOutput = shResult.Range("B" & lastRow + 1)

        If CheckParams(isUsedDU, isUsedELR, isUsedNUM, isUsedFault, isUsedMil, loopingCell, shResult, noSearchCriteriaProvided) = True Then

            Set firstSectionToCopy = shSource.Range("A" & loopingCell.Row, "C" & loopingCell.Row)
            Set secondSectionToCopy = shSource.Range("E" & loopingCell.Row, "I" & loopingCell.Row)
            Set thirdSectionToCopy = shSource.Range("K" & loopingCell.Row, "M" & loopingCell.Row)
            Set rngToCopy = Union(firstSectionToCopy, secondSectionToCopy, thirdSectionToCopy)

            rngToCopy.Copy Destination:=rngOutput

        End If

    Next

    shResult.EnableCalculation = True

End Sub

Public Function CheckParams(isUsedParam1 As Boolean, isUsedParam2 As Boolean, isUsedParam3 As Boolean, loopingCell As Range, shResult As Worksheet, noSearchCriteriaProvided As Boolean) As Boolean

    Dim arraySize As Long
    arraySize = 0

    Dim myArray() As String
    Dim funcTitle As String
    Dim modTitle As String

    ReDim myArray(0)

    If isUsedParam1 = True Then

        arraySize = arraySize + 1
        ReDim Preserve myArray(arraySize - 1)

        myArray(arraySize - 1) = "CheckForParam1Match"

    End If

    If isUsedParam2 = True Then

        arraySize = arraySize + 1
        ReDim Preserve myArray(arraySize - 1)

        myArray(arraySize - 1) = "CheckForParam2Match"

    End If

    If isUsedParam3 = True Then

        arraySize = arraySize + 1
        ReDim Preserve myArray(arraySize - 1)

        myArray(arraySize - 1) = "CheckForParam3Match"

    End If


    'CHECKS IF ARRAY IS "EMPTY"
    If myArray(0) = vbNullString Then

        noSearchCriteriaProvided = True

        Exit Function

    End If

    For i = LBound(myArray) To UBound(myArray)

        funcTitle = myArray(i)
        modTitle = "Search."

        If Application.Run(modTitle & funcTitle, loopingCell, shResult) = False Then

            Exit Function

        End If

    Next

    CheckParams = True

End Function

Function CheckForParam1Match(loopingCell As Range, shResult As Worksheet) As Boolean

    Dim param1 As Range
    Set param1 = shResult.Range("A1")

    If loopingCell.Offset(0, 4).Value = param1.Value Then

        CheckForDUMatch = True

    End If

End Function

Function CheckForParam2Match(loopingCell As Range, shResult As Worksheet) As Boolean

    Dim param2 As Range
    Set param2 = shResult.Range("A2")

    If loopingCell.Offset(0, 5).Value = param2.Value Then

        CheckForELRMatch = True

    End If

End Function

Function CheckForParam3Match(loopingCell As Range, shResult As Worksheet) As Boolean

    Dim param3 As Range
    Set param3 = shResult.Range("A3")

    If loopingCell.Offset(0, 6).Value = param3.Value Then

        CheckForNUMMatch = True

    End If

End Function
like image 989
Henrik Avatar asked Dec 14 '22 17:12

Henrik


1 Answers

Having 6 separate criteria, each of which can independently be either true or false, is like having a six bit binary number:

000000
000001
000010
000011
000100
000101
000110
000111
001000
...
etc.

Cook up some code to calculate an Integer variable (N) which would have values 0 if all criteria were false through 63 if all criteria were true.

Associated with each value would be a macro ( like Macro0, Macro1, etc). Then all you would need would be something like:

Application.Run "Macro" & N
like image 58
Gary's Student Avatar answered May 04 '23 01:05

Gary's Student