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:
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:
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:
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
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:
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:
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:
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
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:
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:
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)
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.
