Click here to Skip to main content
15,901,205 members
Articles / Productivity Apps and Services / Microsoft Office

Excel and VBA - Query ListObject Directly

Rate me:
Please Sign up or sign in to vote.
5.00/5 (2 votes)
9 Nov 2014Ms-PL8 min read 39.1K   740   5   8
A guide on querying Excel ListObjects (Tables) by creating a state-machine out of synthesized objects that resemble a query language.

Introduction

    If you've ever spent much time in the realm of data analysis, you'll probably use Excel in some fashion.  When you need to quickly synthesize data together, sometimes it provides the quickest way to get from point A -> B.  You could fire up a SQL server of sorts, but if you're interacting with data after you've pulled it from your datastore, or you're not provided with such tools, you sometimes have to make due with what you've been left with.

    That's where Querying ListObjects comes in.  Excel 2007+ provides us with Tables which simplify the synthesis of Excel Formulas (because you're not dealing with $A$2:$A$403, you end up using TableName[ColumnName] with ranges that automatically update as they expand.)

    You could filter your tables in place, but if you're needing to do something with a subset of that data, hiding columns, rows, copying what's visible, creating a new sheet/workbook and the like can become arduous; especially if some of the filters get complicated.

Background

    If you've used querying languages before, you'll know that they provide an easy way to gather data from a preexisting source.  You know the structure, and it's fairly stable, and the results enable you to do further processing.

    What's presented here is the first step in a pseudo query within Excel, it doesn't yet perform Joins but as time progresses it might get to that point.  One purpose behind writing the query within VBA, versus loading the table structure through ADO, is intellisense.

Breaking into the code

    The example provided is a bit contrived, it was automated due to the complexity of such an infrastructure.

    Not included is a <Document_Structure> worksheet, which was 'very hidden', it aided in the process of (fairly dumb) refactoring.  On my end when a column, table, or worksheet is renamed, it would utilize this 'previous state' to know what it was, to move onto what it is now. It doesn't handle overlapping contexts so if I had a table with the same name as a column, it would likely fail later if either were renamed.  This was removed because it's not relevant to the focus of the article and just made the file bigger.

    Onto the code, setting up an actual query-ish syntax is a fairly complex ordeal, but once automated I believe the results are more than worth the effort.  To provide a fairly useful bit of intellisense within this model, interacting with the rows and columns has been simplified.  Let's start with the overall example model overview:

  • ExampleData
  • ListOrderingTable
  • ListOrderingTableRow
  • ListOrderingTableRows
  • OrderDetailsData
  • OrderDetailsQuery
  • OrderDetailsQueryCondition
  • OrderDetailsQueryHead
  • OrderDetailsQueryOpPart
  • OrderDetailsQueryOrderByParent
  • OrderDetailsQueryOrderByPart
  • OrderDetailsQueryPart
  • OrderDetailsSelectParent
  • OrderDetailsSelectPart
  • OrderingTableOrderByBuilder
  • OrderingTableQuery
  • OrderingTableQueryBuilder
  • OrderingTableSelectBuilder
  • OrderingTableWhereBuilder

    As you can tell, that's a pretty tall order!

    Like everything, big or small, it's easier once you break it down:

    ExampleData - The Main Sheet in question is called 'Example' within the VBA project.  ExampleData is the class that represents its data points of interest. In this case it maintains a property named OrderingTable of type ListOrderingTable.  On the worksheet side of things, the actual Table is named, as you can guess, 'OrderingTable'. 

   Your first question might be to ask: why maintain the data as a class separate from the actual worksheet?

    If you've worked with excel data as much as I have you'd understand that sometimes you might want your code separate from your data.  So in this instance, if I built the model I might want to operate on a *separate* workbook, or multiple workbooks that all share a common data model.

    Case in point: the automation model that inspects a given workbook injects its own state tracking worksheet.  If I embed it into the worksheet, I lose the ability to instance and associate to a different data source.

Back to the data, ListOrderingTable maintains the columns as they appear within the actual Worksheet:

ID Name Description Category Price Quantity Total Cost

    The properties on the ListOrderingTable are as follows:

VB
Public Property Get ID() As ListColumn
    Set ID = Source.ListColumns("ID")
End Property

Public Property Get Name() As ListColumn
    Set Name = Source.ListColumns("Name")
End Property

Public Property Get Description() As ListColumn
    Set Description = Source.ListColumns("Description")
End Property

Public Property Get Category() As ListColumn
    Set Category = Source.ListColumns("Category")
End Property

Public Property Get Price() As ListColumn
    Set Price = Source.ListColumns("Price")
End Property

Public Property Get Quantity() As ListColumn
    Set Quantity = Source.ListColumns("Quantity")
End Property

Public Property Get TotalCost() As ListColumn
    Set TotalCost = Source.ListColumns("Total Cost")
End Property

    These are referenced later in the matching aspect of the query.

    The Rows within this custom construct also mimic the structure above.  They have a call-out for each column and yield a range, this simplifies working with an iterative approach to interrogating these objects.  This was built as a stepping stone prior to creating the query.

    The Guts of the query exist within OrderDetailsQuery, it builds the actual query itself with the information provided by the Query Builders.  The reason for the separation of concerns is: if I had multiple tables I wanted to provide query for, replicating that code needlessly would just bloat the document further.

    Let's take a look at a sample query on our test data:

VB
Set otQuery = _
    DataModel.QueryExample.OrderingTable.GetQueryBuilder() _
        .Where(OD_OTC_ID, OD_MC_GreaterThan, 10000) _
            .AndAlso(OD_OTC_ID, OD_MC_LessThan, 40000) _
            .AndAlso(OD_OTC_Name, OD_MC_DoesNotStartWith, "Mashed") _
        .OrElse(OD_OTC_Name, OD_MC_Contains, "Mashed") _
            .AndAlsoOpenParen(OD_OTC_Price, OD_MC_LessThan, 4) _
                .OrElse(OD_OTC_Price, OD_MC_GreaterThan, 7) _
            .CloseParen() _
        .OrderBy(OD_OTC_ID, OD_OD_Ascending) _
        .SelectColumn(OD_OTC_ID) _
            .AndAlso(OD_OTC_Name) _
            .AndAlso(OD_OTC_Price) _
            .AndAlso(OD_OTC_Quantity) _
            .AndAlso(OD_OTC_TotalCost).Build

    Pretty straightforward, once you get used to dropping the OD_OTC_, OD_MC_, and OD_OD_ parts.  The query is basically looking for the items within the table which have an ID greater than 10000, which are also less than 40000, and do not have a name that starts with 'Mashed'; OR items that contain 'Mashed', and have a (price less than 4 or greater than 7).  Which is then ordered by ID, ascending, with the ID, Name, Price, Quantity and Total Cost in the results.

    While looping over the data yourself makes pulling the matches out pretty simple, constructing the query model makes adding, removing, ordering, and changing the criteria extremely simple. Intellisense added in is an extra bonus.

    The purpose of the 'QueryBuilder' is to simplify the process of gathering the necessary information for building the query.  It is the most efficient means of doing so without constantly reconstructing the state-machine that would lie underneath the scenes.  This is also why the 'Build' is called explicitly.  If you 'SelectAll' the build method is unnecessary.


    Now that we have the query, let's take a look at the 'Build' method, which comes in three steps, starting with the Build on the OrderingTableSelectBuilder:

VB
Public Function Build() As OrderingTableQuery
    Dim m_qry_Result As OrderingTableQuery
    Set m_qry_Result = New OrderingTableQuery
    m_qry_Result.Build Me
    Set Build = m_qry_Result
End Function

    Then the Build on OrderingTableQuery

VB
Friend Sub Build(vTarget As Variant)
    Set m_qry_Query = New OrderDetailsQuery
    Set m_lst_Source = m_qry_Query.Build(vTarget)
End Sub

    Followed finally by the OrderDetailsQuery:

VB
Friend Function Build(target As Variant) As Variant
    Dim m_int_Index As Integer
    Dim m_col_Leafs As Collection
    Dim m_col_Orderings As Collection
    Dim m_col_Selects As Collection
    Dim m_col_Actions As Collection
    Dim m_var_Current As Variant
    Dim m_int_ParenLevel As Integer
    Dim m_qop_Part As OrderDetailsQueryOpPart
    Dim m_qpt_Part As OrderDetailsQueryPart
    Dim m_var_Source As Variant
    Set m_var_Source = Nothing
    If Not IsObject(target) Then _
        Exit Function
    Set m_col_Leafs = New Collection
    Set m_col_Orderings = New Collection
    Set m_col_Selects = New Collection
    Set m_col_Actions = New Collection
    Set m_var_Current = target
    While Not m_var_Current Is Nothing
        If TypeOf m_var_Current Is OrderDetailsSelectPart Then
            m_int_ParenLevel = 0
            Dim m_spt_Select As OrderDetailsSelectPart
            Set m_spt_Select = m_var_Current
            If m_col_Selects.Count = 0 Then
                m_col_Selects.Add m_spt_Select
            Else
                m_col_Selects.Add m_spt_Select, , 1
            End If
            Set m_var_Current = m_spt_Select.Parent
        ElseIf TypeOf m_var_Current Is OrderDetailsQueryOrderByPart Then
            m_int_ParenLevel = 0
            Dim m_obp_OrderBy As OrderDetailsQueryOrderByPart
            Set m_obp_OrderBy = m_var_Current
            If m_col_Orderings.Count = 0 Then
                m_col_Orderings.Add m_obp_OrderBy
            Else
                m_col_Orderings.Add m_obp_OrderBy, , 1
            End If
            Set m_var_Current = m_obp_OrderBy.Parent
        ElseIf TypeOf m_var_Current Is OrderDetailsQueryOpPart Then
            Set m_qop_Part = m_var_Current
            If Not m_qop_Part.InitialCondition Is Nothing Then
                If m_col_Leafs.Count = 0 Then
                    m_col_Leafs.Add m_qop_Part.InitialCondition
                Else
                    m_col_Leafs.Add m_qop_Part.InitialCondition, , 1
                End If
            End If
            If m_col_Actions.Count = 0 Then
                m_col_Actions.Add m_qop_Part.Action
            Else
                m_col_Actions.Add m_qop_Part.Action, Before:=1
            End If
            m_int_ParenLevel = 0
            Set m_var_Current = m_qop_Part.Parent
        ElseIf TypeOf m_var_Current Is OrderDetailsQueryHead Then
            Dim m_qrh_Head As OrderDetailsQueryHead
            Set m_qrh_Head = m_var_Current
            If Not IsEmpty(m_qrh_Head.Source) And IsObject(m_qrh_Head.Source) Then
                Set m_var_Source = m_qrh_Head.Source
            End If
            Set m_var_Current = Nothing
        End If
    Wend
    If m_col_Actions.Count > 0 Then
        m_col_Actions.Add OD_QueryPartAction.OD_QPA_Finish
        Dim m_qpa_Actions() As OD_QueryPartAction
        Dim m_cnd_Conditions() As OrderDetailsQueryCondition
        ReDim m_qpa_Actions(1 To m_col_Actions.Count)
        ReDim m_cnd_Conditions(1 To m_col_Leafs.Count)
    End If
    If m_col_Selects.Count > 0 Then
        m_int_SelectCount = m_col_Selects.Count
        ReDim m_ina_Selects(1 To m_int_SelectCount)
        For m_int_Index = 1 To m_col_Selects.Count
            Set m_spt_Select = m_col_Selects(m_int_Index)
            m_ina_Selects(m_int_Index) = m_spt_Select.Column
        Next
    Else
        m_int_SelectCount = 0
    End If
    If m_col_Orderings.Count > 0 Then
        m_int_OrderingCount = m_col_Orderings.Count
        ReDim m_ina_OrderingColumns(1 To m_int_OrderingCount)
        ReDim m_oda_OrderingDirections(1 To m_int_OrderingCount)
        For m_int_Index = 1 To m_int_OrderingCount
            Set m_obp_OrderBy = m_col_Orderings(m_int_Index)
            m_oda_OrderingDirections(m_int_Index) = m_obp_OrderBy.Direction
        Next
    Else
        m_int_OrderingCount = 0
    End If
    For m_int_Index = 1 To m_col_Actions.Count
        m_qpa_Actions(m_int_Index) = m_col_Actions(m_int_Index)
    Next
    For m_int_Index = 1 To m_col_Leafs.Count
        Set m_cnd_Conditions(m_int_Index) = m_col_Leafs(m_int_Index)
    Next
    Dim m_col_References As Collection
    Dim m_cnd_Current As OrderDetailsQueryCondition
    Dim m_int_ColumnIndex As Integer
    Dim m_int_CurrentTarget As Integer
    If m_col_Actions.Count > 0 Then
        ReDim m_ina_CriteriaTargets(1 To m_col_Leafs.Count)
        ReDim m_ina_FailJumps(1 To m_col_Leafs.Count)
        ReDim m_ina_PassJumps(1 To m_col_Leafs.Count)
        ReDim m_mca_Criteria(1 To m_col_Leafs.Count)
        ReDim m_vra_RHSCriteria(1 To m_col_Leafs.Count)
    End If
    Set m_col_References = New Collection
    For m_int_Index = 1 To m_col_Leafs.Count
        Set m_cnd_Current = m_col_Leafs(m_int_Index)
        m_mca_Criteria(m_int_Index) = m_cnd_Current.Operator
        If IsObject(m_cnd_Current.Value) Then
            Set m_vra_RHSCriteria(m_int_Index) = m_cnd_Current.Value
        Else
            m_vra_RHSCriteria(m_int_Index) = m_cnd_Current.Value
        End If
        Dim m_int_TargetIndex As Integer
        Dim m_boo_ColumnPresent As Boolean
        m_boo_ColumnPresent = False
        For m_int_TargetIndex = 1 To m_col_References.Count
            m_int_CurrentTarget = m_col_References(m_int_TargetIndex)
            If m_int_CurrentTarget = m_cnd_Current.Column Then
                m_int_ColumnIndex = m_int_TargetIndex
                m_boo_ColumnPresent = True
                Exit For
            End If
        Next
        If Not m_boo_ColumnPresent Then
            m_col_References.Add m_cnd_Current.Column
            m_int_ColumnIndex = m_col_References.Count
        End If
        m_ina_CriteriaTargets(m_int_Index) = m_int_ColumnIndex
    Next
    m_int_CriteriaReferenceCount = m_col_References.Count
    For m_int_Index = 1 To m_col_Orderings.Count
        Set m_obp_OrderBy = m_col_Orderings(m_int_Index)
        m_boo_ColumnPresent = False
        For m_int_TargetIndex = 1 To m_col_References.Count
            m_int_CurrentTarget = m_col_References(m_int_TargetIndex)
            If m_int_CurrentTarget = m_obp_OrderBy.Column Then
                m_int_ColumnIndex = m_int_TargetIndex
                m_boo_ColumnPresent = True
                Exit For
            End If
        Next
        If Not m_boo_ColumnPresent Then
            m_col_References.Add m_obp_OrderBy.Column
            m_int_ColumnIndex = m_col_References.Count
        End If
        m_ina_OrderingColumns(m_int_Index) = m_int_ColumnIndex
    Next
    m_int_AdditionalOrderingReferenceCount = m_col_References.Count - m_int_CriteriaReferenceCount
    For m_int_Index = 1 To m_col_Selects.Count
        Dim m_int_CurrentSelectColumn As Integer
        m_int_CurrentSelectColumn = m_ina_Selects(m_int_Index)
        m_boo_ColumnPresent = False
        For m_int_TargetIndex = 1 To m_col_References.Count
            m_int_CurrentTarget = m_col_References(m_int_TargetIndex)
            If m_int_CurrentSelectColumn = m_int_CurrentTarget Then
                m_boo_ColumnPresent = True
                m_int_ColumnIndex = m_int_TargetIndex
                Exit For
            End If
        Next
        If Not m_boo_ColumnPresent Then
            m_col_References.Add m_int_CurrentSelectColumn
            m_int_ColumnIndex = m_col_References.Count
        End If
        m_ina_Selects(m_int_Index) = m_int_ColumnIndex
    Next
    m_int_AdditionalSelectReferenceCount = m_col_References.Count - (m_int_CriteriaReferenceCount + m_int_AdditionalOrderingReferenceCount)
    m_int_ReferencedColumnCount = m_col_References.Count
    ReDim m_ina_Type(1 To m_int_ReferencedColumnCount)
    For m_int_Index = 1 To m_int_ReferencedColumnCount
        m_ina_Type(m_int_Index) = m_col_References(m_int_Index)
    Next
    If m_col_Actions.Count > 0 Then
        BuildQueryLogicalOrLeafs m_cnd_Conditions, m_qpa_Actions, 1, m_col_Actions.Count, 0, 0
    End If
    Set Build = m_var_Source
End Function

    As you can see, the first step it takes is to deconstruct the query builders, starting from the right-most node all the way to the query builder head.  When there are criteria within the query, it knows then to build the query starting with the highest-order component, the 'OrElse' aspect.  In a normal langauge this would be the highest order precedence (or last point of evaluation, depends on how you view it).

    You'll notice most of this is solely concerned with reference tracking.  To avoid loading a column more than once during the evaluation of the query, it reindexes everything to a baseline.  So if Select and Orderby and Where refer to ID, they all end up using the same index, starting at one (1) up to the total number of references.

    Starting with the 'OrElse' operator, let's take a look at what it's doing:

VB
Private Sub BuildQueryLogicalOrLeafs(cndConditions() As OrderDetailsQueryCondition, qpaActions() As OD_QueryPartAction, iStart As Integer, iEnd As Integer, iFailTarget As Integer, iPassTarget As Integer)
    Dim m_col_OrPoints As Collection
    Dim m_int_Index As Integer
    Dim m_int_ParenDepth As Integer
    Dim m_boo_AddingOr As Boolean
    Dim m_int_CurrentStart As Integer
    Dim m_int_CurrentEnd As Integer
    Set m_col_OrPoints = New Collection
    If iStart <> iEnd Then
        For m_int_Index = iStart To iEnd - 1
            Select Case qpaActions(m_int_Index)
                Case OD_QPA_OpenParen
                    m_int_ParenDepth = m_int_ParenDepth + 1
                Case OD_QPA_CloseParen
                    m_int_ParenDepth = m_int_ParenDepth - 1
                Case OD_QPA_OrElse
                    If m_int_ParenDepth = 0 Then _
                        m_col_OrPoints.Add m_int_Index
            End Select
        Next
    End If
    m_int_CurrentStart = iStart
    If m_col_OrPoints.Count = 0 Then
        m_int_CurrentEnd = iEnd
        BuildQueryLogicalAndLeafs cndConditions, qpaActions, CorrectTarget(m_int_CurrentStart, qpaActions), CorrectTarget(m_int_CurrentEnd, qpaActions), iFailTarget, iPassTarget
    Else
        For m_int_Index = 1 To m_col_OrPoints.Count
            m_int_CurrentEnd = m_col_OrPoints(m_int_Index)
            Dim m_int_CorrectedFailTarget As Integer
            m_int_CorrectedFailTarget = CorrectTarget((m_int_CurrentEnd + 1) + CorrectJumpTarget(qpaActions, m_int_CurrentEnd + 1) - CorrectJumpTarget(qpaActions, m_int_CurrentEnd), qpaActions)
            While qpaActions(m_int_CorrectedFailTarget) = OD_QPA_CloseParenPadding Or qpaActions(m_int_CorrectedFailTarget) = OD_QPA_CloseParen
                m_int_CorrectedFailTarget = m_int_CorrectedFailTarget + 1
                If m_int_CorrectedFailTarget > UBound(qpaActions) Then
                    m_int_CorrectedFailTarget = UBound(qpaActions)
                    GoTo ExitWend
                End If
            Wend
ExitWend:
            BuildQueryLogicalAndLeafs cndConditions, qpaActions, m_int_CurrentStart, m_int_CurrentEnd, m_int_CorrectedFailTarget, iPassTarget
            m_int_CurrentStart = m_int_CurrentEnd + 1
        Next
        m_int_CurrentEnd = iEnd
        BuildQueryLogicalAndLeafs cndConditions, qpaActions, CorrectTarget(m_int_CurrentStart, qpaActions), CorrectTarget(m_int_CurrentEnd, qpaActions), iFailTarget, iPassTarget
    End If
End Sub

    Following into the AndAlso:

VB
Private Sub BuildQueryLogicalAndLeafs(cndConditions() As OrderDetailsQueryCondition, qpaActions() As OD_QueryPartAction, iStart As Integer, iEnd As Integer, iFailTarget As Integer, iPassTarget As Integer)
    Dim m_col_AndPoints As Collection
    Dim m_int_Index As Integer
    Dim m_int_ParenDepth As Integer
    Dim m_int_CurrentStart As Integer, _
        m_int_CurrentEnd   As Integer
    Dim m_int_EndAdjusted As Integer
    Set m_col_AndPoints = New Collection
    If iStart <> iEnd Then
        For m_int_Index = iStart To iEnd - 1
            Select Case qpaActions(m_int_Index)
                Case OD_QPA_OpenParen
                    m_int_ParenDepth = m_int_ParenDepth + 1
                Case OD_QPA_CloseParen
                    m_int_ParenDepth = m_int_ParenDepth - 1
                Case OD_QPA_AndAlso
                    If m_int_ParenDepth = 0 Then _
                        m_col_AndPoints.Add m_int_Index
            End Select
        Next
    End If
    If m_col_AndPoints.Count = 0 Then
        If qpaActions(iStart) = OD_QPA_OpenParen Then
            BuildQueryLogicalParenLeafs cndConditions, qpaActions, iStart, iEnd, iFailTarget, iPassTarget
        Else
            'When we're nested as deep as we can go...
            m_int_EndAdjusted = iEnd - CorrectJumpTarget(qpaActions, iEnd)
            
            m_ina_FailJumps(m_int_EndAdjusted) = iFailTarget - CorrectJumpTarget(qpaActions, iFailTarget)
            m_ina_PassJumps(m_int_EndAdjusted) = iPassTarget - CorrectJumpTarget(qpaActions, iPassTarget)
        End If
    Else
        m_int_CurrentStart = iStart
        For m_int_Index = 1 To m_col_AndPoints.Count
            m_int_CurrentEnd = m_col_AndPoints(m_int_Index)
            Dim m_int_CorrectedPassTarget As Integer
            m_int_CorrectedPassTarget = CorrectTarget((m_int_CurrentEnd + 1) + CorrectJumpTarget(qpaActions, m_int_CurrentEnd + 1) - CorrectJumpTarget(qpaActions, m_int_CurrentEnd), qpaActions)
            While qpaActions(m_int_CorrectedPassTarget) = OD_QPA_CloseParenPadding Or qpaActions(m_int_CorrectedPassTarget) = OD_QPA_CloseParen
                m_int_CorrectedPassTarget = m_int_CorrectedPassTarget + 1
                If m_int_CorrectedPassTarget > UBound(qpaActions) Then
                    m_int_CorrectedPassTarget = UBound(qpaActions)
                    GoTo ExitWend
                End If
            Wend
ExitWend:
            BuildQueryLogicalOrLeafs cndConditions, qpaActions, m_int_CurrentStart, m_int_CurrentEnd, iFailTarget, m_int_CorrectedPassTarget
            m_int_CurrentStart = m_int_CurrentEnd + 1
        Next
        m_int_CurrentEnd = iEnd
        If qpaActions(m_int_CurrentStart) = OD_QPA_OpenParen Then
            BuildQueryLogicalParenLeafs cndConditions, qpaActions, m_int_CurrentStart, m_int_CurrentEnd, iFailTarget, iPassTarget
        Else
            BuildQueryLogicalOrLeafs cndConditions, qpaActions, m_int_CurrentStart, m_int_CurrentEnd, iFailTarget, iPassTarget
        End If
    End If
End Sub

    And finally the lowest order (or first) operator, the parenthesis:

VB
Private Sub BuildQueryLogicalParenLeafs(cndConditions() As OrderDetailsQueryCondition, qpaActions() As OD_QueryPartAction, iStart As Integer, iEnd As Integer, iFailTarget As Integer, iPassTarget As Integer)
    Dim m_int_ParenDepth As Integer
    Dim m_int_Index As Integer
    Dim m_int_ZeroPoint As Integer
    If qpaActions(iStart) = OD_QPA_OpenParen Then
        For m_int_Index = iStart To iEnd
            Select Case qpaActions(m_int_Index)
                Case OD_QPA_OpenParen
                    m_int_ParenDepth = m_int_ParenDepth + 1
                Case OD_QPA_CloseParen
                    m_int_ParenDepth = m_int_ParenDepth - 1
                    If m_int_ParenDepth = 0 Then
                        m_int_ZeroPoint = m_int_Index
                        Exit For
                    End If
            End Select
        Next
        If m_int_ParenDepth <= 0 Then
            BuildQueryLogicalOrLeafs cndConditions, qpaActions, iStart + 1, m_int_ZeroPoint - 1, iFailTarget, iPassTarget
        End If
    End If
End Sub

    You'll notice the QPA scattered about, which refers to: Query Part Action, in essence the builders are synthesizing constants that in effect represent a string of operators.  The early design choice of separating that stream from the operands are why there are odd 'CloseParenPadding' and the need to Correct Jump targets.

    Jump targets, within the context of this query state machine, refer to how short circuiting was implemented.  I chose the words 'AndAlso' and 'OrElse' due to their presence in VB.NET and their intended goal: evaluation only as far as needed.

    Within the match method, below, you'll notice the match on each line is simply just a set of jump targets that are used based on whether the criterion was met.  If it is go to 'p' criterion, or goto 'f' criterion for failures.  When either instruct it to jump to criterion zero, it either fully passes the match or fails to match:

VB
Friend Function MatchInternal(ByRef lCount As Long, vraDataSource() As Variant, qOperation As OD_QueryOperation) As Variant
    Dim m_lna_MatchingLines() As Long
    Dim m_lng_MatchingLineDimension As Long
    Dim m_lng_MatchingLineCount As Long
    Dim m_lng_LineIndex As Long
    Dim m_var_CurrentLHS As Variant, _
        m_var_CurrentRHS As Variant
    Dim m_boo_LastIsMatch As Boolean
    Dim m_var_BetMin As Variant
    Dim m_var_BetMax As Variant
    Dim m_var_CurrentRHSElement As Variant
    Dim m_lng_NewMatchLength As Long
    Dim m_int_Ordering As Long
    If m_int_CriteriaReferenceCount <> 0 Then
        m_lng_MatchingLineDimension = 4
        ReDim m_lna_MatchingLines(1 To m_lng_MatchingLineDimension)
        '**********************************
        ' Go through each line, on each go
        ' through the full criteria; with
        ' exception to terminal edges which
        ' yield a pass or fail.
        '**********************************
        For m_lng_LineIndex = 1 To lCount
            Dim m_int_CriteriaID As Long
            m_int_CriteriaID = 1
            While m_int_CriteriaID <> 0
                m_boo_LastIsMatch = False
                If lCount = 1 Then
                    m_var_CurrentLHS = vraDataSource(m_ina_CriteriaTargets(m_int_CriteriaID))
                Else
                    m_var_CurrentLHS = vraDataSource(m_ina_CriteriaTargets(m_int_CriteriaID))(m_lng_LineIndex, 1)
                End If
                m_var_CurrentRHS = m_vra_RHSCriteria(m_int_CriteriaID)
                Select Case m_mca_Criteria(m_int_CriteriaID)
                    Case OD_MC_HasFlag
                        m_boo_LastIsMatch = (m_var_CurrentLHS And m_var_CurrentRHS) = m_var_CurrentRHS
                    Case OD_MC_NotHasFlag
                        m_boo_LastIsMatch = (m_var_CurrentLHS And m_var_CurrentRHS) <> m_var_CurrentRHS
                    Case OD_MC_EqualTo
                        m_boo_LastIsMatch = m_var_CurrentLHS = m_var_CurrentRHS
                    Case OD_MC_LessThan
                        m_boo_LastIsMatch = m_var_CurrentLHS < m_var_CurrentRHS
                    Case OD_MC_GreaterThan
                        m_boo_LastIsMatch = m_var_CurrentLHS > m_var_CurrentRHS
                    Case OD_MC_GreaterThanOrEqualTo
                        m_boo_LastIsMatch = m_var_CurrentLHS >= m_var_CurrentRHS
                    Case OD_MC_LessThanOrEqualTo
                        m_boo_LastIsMatch = m_var_CurrentLHS <= m_var_CurrentRHS
                    Case OD_MC_Between
                        If IsArray(m_var_CurrentRHS) Then
                            m_var_BetMin = m_var_CurrentRHS(LBound(m_var_CurrentRHS))
                            m_var_BetMax = m_var_CurrentRHS(UBound(m_var_CurrentRHS))
                            m_boo_LastIsMatch = m_var_BetMin <= m_var_CurrentLHS And m_var_CurrentLHS <= m_var_BetMax
                        End If
                    Case OD_MC_Contains
                        m_boo_LastIsMatch = InStr(1, m_var_CurrentLHS, m_var_CurrentRHS) <> 0
                    Case OD_MC_DoesNotContain
                        m_boo_LastIsMatch = InStr(1, m_var_CurrentLHS, m_var_CurrentRHS) = 0
                    Case OD_MC_DoesNotEndWith
                        m_boo_LastIsMatch = InStrRev(m_var_CurrentLHS, m_var_CurrentRHS) <> Len(m_var_CurrentLHS) - (Len(m_var_CurrentRHS) - 1)
                    Case OD_MC_DoesNotStartWith
                        m_boo_LastIsMatch = InStr(1, m_var_CurrentLHS, m_var_CurrentRHS) <> 1
                    Case OD_MC_EndsWith
                        m_boo_LastIsMatch = InStrRev(m_var_CurrentLHS, m_var_CurrentRHS) = Len(m_var_CurrentLHS) - (Len(m_var_CurrentRHS) - 1)
                    Case OD_MC_In
                        If IsArray(m_var_CurrentRHS) Then
                            For Each m_var_CurrentRHSElement In m_var_CurrentRHS
                                If m_var_CurrentRHSElement = m_var_CurrentLHS Then
                                    m_boo_LastIsMatch = True
                                    Exit For
                                End If
                            Next
                        End If
                    Case OD_MC_Like
                        m_boo_LastIsMatch = m_var_CurrentLHS Like m_var_CurrentRHS
                    Case OD_MC_NotBetween
                        If IsArray(m_var_CurrentRHS) Then
                            m_var_BetMin = m_var_CurrentRHS(LBound(m_var_CurrentRHS))
                            m_var_BetMax = m_var_CurrentRHS(UBound(m_var_CurrentRHS))
                            m_boo_LastIsMatch = m_var_CurrentLHS > m_var_BetMin Or m_var_BetMax < m_var_CurrentLHS
                        End If
                    Case OD_MC_NotEqualTo
                        m_boo_LastIsMatch = m_var_CurrentLHS <> m_var_CurrentRHS
                    Case OD_MC_NotIn
                        If IsArray(m_var_CurrentRHS) Then
                            m_boo_LastIsMatch = True
                            For Each m_var_CurrentRHSElement In m_var_CurrentRHS
                                If m_var_CurrentRHSElement = m_var_CurrentLHS Then
                                    m_boo_LastIsMatch = False
                                    Exit For
                                End If
                            Next
                        End If
                    Case OD_MC_NotLike
                        m_boo_LastIsMatch = Not m_var_CurrentLHS Like m_var_CurrentRHS
                    Case OD_MC_StartsWith
                        m_boo_LastIsMatch = InStr(1, m_var_CurrentLHS, m_var_CurrentRHS) = 1
                End Select
                If m_boo_LastIsMatch Then
                    m_int_CriteriaID = m_ina_PassJumps(m_int_CriteriaID)
                Else
                    m_int_CriteriaID = m_ina_FailJumps(m_int_CriteriaID)
                End If
            Wend
            If m_boo_LastIsMatch Then
                Select Case qOperation
                    Case OD_QO_Any
                        MatchInternal = True
                        Exit Function
                    Case OD_QO_Count
                        m_lng_MatchingLineCount = m_lng_MatchingLineCount + 1
                    Case OD_QO_Select
                        If m_lng_MatchingLineCount >= m_lng_MatchingLineDimension Then
                            m_lng_NewMatchLength = m_lng_MatchingLineDimension * 2
                            ReDim Preserve m_lna_MatchingLines(1 To m_lng_NewMatchLength)
                            m_lng_MatchingLineDimension = m_lng_NewMatchLength
                        End If
                        m_lng_MatchingLineCount = m_lng_MatchingLineCount + 1
                        m_lna_MatchingLines(m_lng_MatchingLineCount) = m_lng_LineIndex
                End Select
            End If
        Next
        Select Case qOperation
            Case OD_QO_Any
                MatchInternal = False
            Case OD_QO_Count
                MatchInternal = m_lng_MatchingLineCount
            Case OD_QO_Select
                If m_lng_MatchingLineCount > 0 Then
                    ReDim Preserve m_lna_MatchingLines(1 To m_lng_MatchingLineCount)
                    If lCount > 1 And m_lng_MatchingLineCount > 1 And m_int_OrderingCount > 0 Then
                        QuickPivotSort vraDataSource, m_lna_MatchingLines, 1, m_lng_MatchingLineCount
                    End If
                Else
                    Dim m_lna_DummyResult() As Long
                    m_lna_MatchingLines = m_lna_DummyResult
                End If
                lCount = m_lng_MatchingLineCount
                MatchInternal = m_lna_MatchingLines
        End Select
    Else
        Select Case qOperation
            Case OD_QO_Any
                MatchInternal = lCount > 0
            Case OD_QO_Count
                MatchInternal = lCount
            Case OD_QO_Select
                If lCount > 0 Then
                    ReDim m_lna_MatchingLines(1 To lCount)
                    For m_lng_LineIndex = 1 To lCount
                        m_lna_MatchingLines(m_lng_LineIndex) = m_lng_LineIndex
                    Next
                    If lCount > 1 And m_int_OrderingCount > 0 Then
                        QuickPivotSort vraDataSource, m_lna_MatchingLines, 1, lCount
                    End If
                Else
                    m_lna_MatchingLines = m_lna_DummyResult
                End If
                MatchInternal = m_lna_MatchingLines
        End Select
    End If
End Function

    You'll notice the trailing aspects of the query change depending on the 'QueryOperation' (qOperation) which will yield early if you're just asking if there is a match, or just focus on counting if tracking what matched is not needed.

Points of Interest

    I learned through this process that separating the operators from operands just creates a bigger headache than it is worth. This illustrates on a basic level how short circuiting works from a logical flow standpoint. If you were to unfold this into a proper compiler it would likely construct concrete instruction jumps to the fail points if there were alternative routes to meeting the criteria; however, I think that's a topic for another day!

    The full source is contained within the TestBook.zip's "Test Book.xlsm".

History

November 09, 2014 - Initial post.

November 09, 2014 - Added Download link.  Which I thought was automatic!

November 12, 2014 - Updated formatting for blocks to show as 'VB.NET' due to CodeProject parsing issues. Doesn't understand 'Friend' keyword in VBScript, and VBA isn't a valid language choice.

License

This article, along with any associated source code and files, is licensed under The Microsoft Public License (Ms-PL)


Written By
Software Developer
United States United States
Hobbyist programmer, I write and generate code for fun.

Comments and Discussions

 
NewsModel Automation Query Pin
Allen C. Copeland Jr18-Nov-14 19:12
Allen C. Copeland Jr18-Nov-14 19:12 
QuestionDid you notice...? Pin
Nelek10-Nov-14 3:38
protectorNelek10-Nov-14 3:38 
AnswerRe: Did you notice...? Pin
Allen C. Copeland Jr10-Nov-14 7:27
Allen C. Copeland Jr10-Nov-14 7:27 
GeneralRe: Did you notice...? Pin
Nelek10-Nov-14 9:41
protectorNelek10-Nov-14 9:41 
GeneralRe: Did you notice...? Pin
Allen C. Copeland Jr11-Nov-14 20:16
Allen C. Copeland Jr11-Nov-14 20:16 
GeneralRe: Did you notice...? Pin
Nelek11-Nov-14 21:56
protectorNelek11-Nov-14 21:56 
QuestionExcel and VBA Programming Pin
sten200510-Nov-14 2:22
sten200510-Nov-14 2:22 
AnswerRe: Excel and VBA Programming Pin
Allen C. Copeland Jr10-Nov-14 13:06
Allen C. Copeland Jr10-Nov-14 13:06 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.