Access Listbox Resize Class

Option Compare Database
Option Explicit
Option Base 0

' Allows the columns on a ListBox control to be resized.
'
' Written by Alex Wellerstein in 2007, released without any stipulations or warranties.
'  http://alexwellerstein.com/msaccess/
'
' Ben Sacherich - 3/28/2016:  Turned this into a class module.  I will note that I experimented with another column
' resizing class made by Stephen Lebans but didn't like the way it resized columns.  This code seemed simpler to implement.
'
'
' Usage:
'
'    '//// Add this line to the module header ////
'    Private ListboxColumnResize As clsListboxColumnResize
'
'
'    '//// Add these lines to the Form_Load() event. ////
'    ' Create a new instance of our class
'    Set ListboxColumnResize = New clsListboxColumnResize
'
'    ' We must tell the Class which control we want to work with.
'    ListboxColumnResize.SetupListbox <ListBox Control>
'
'    ' Turn on our flag to allow column heading sort.  This defaults to True when the list has column headings.
'    ListboxColumnResize.EnableColumnHeadingSort = True
'
'    ' Identify clickable column heading labels for sorting.
'    ' If you have a hidden column with no heading, like when column 0 is hidden, just pass the next visible
'    ' column heading label twice in a row.
'    'ListboxColumnResize.SetupColumnLabels lblCode, lblItem, lblName, lblLength
'
'    '//// Add this to the Form_Unload() for proper cleanup ////
'    Private Sub Form_Unload(Cancel As Integer)
'        ' Release the reference to our class
'        Set ListboxColumnResize = Nothing
'    End Sub
'
' In each case of <ListBox Control>, substitute the name of the ListBox control.
'
' That's it! If you want to make captions move along with the columns that are being
' resized, you can use the DividerLeft function to get the .Left position for the
' caption on the form based on the current column positions.
'
' You can adjust the ListResizeMouseTolerance constant if you want to change how
' "sticky" the column dividers are (how close to them you need to click).

'############ WARNING ############
' This routine causes Access 2010 to crash hard if the .ColumnWidths is modfied during the MouseMove event.
' The suggested work around is to call the ListColumnResizeMouseDown() function from the MouseUp event.  The
' only downside of this seems to be the visual feedback of seeing the column resize as you drag.
' Ben Sacherich and Anders Ebro ("The Smiley Coder") - March 2016

' Ben Sacherich - 3/28/2016:  Turned this into a class module.  I will note that I experimented with another column
' resizing class made by Stephen Lebans but didn't like the way it resized columns.  This code seemed simpler to convert.
'
' Limitations:
'   - The user may not discover that columns are resizable because the mouse cursor does not
'       change as it hovers over a column divider.
'   - The user does not see the column resize until they release the mouse button.
'   - The columns can be resized by grabbing any visible divider, not just in the column heading.
'       This allows it to work even when column headings are not visible, but then requires
'       additional work to get the headings to resposition.  The SetupColumnLabels() method
'       may help with this but it has limitations, like not handling hidden columns.
'   - You can't drag a column width past the next column divider in one drag.  It takes multiple steps.
'   - In my testing DividerLeft() was not positioning the last column after the first resize.
'       I ran out of time debugging this so it will have to wait until another day.
'
' BS 7/5/2016:  I was getting annoyed by the resize routine intercepting regular row clicks so I modified
'       it to only let the columns resize if clicking dividers near the top of the list.
'       MouseY of 400 is about two list rows of Tahoma 8.

'this is how many twips to the left or right of a column divider that will be recogized as having clicked on it
Private Const ListResizeMouseTolerance = 100 '200

'these are used to keep track of when it is dragging
Private IsColumnResizing As Boolean
Private ResizingColumn As Integer

Private Const EnableEvents As String = "[Event Procedure]"

Private WithEvents mListbox As ListBox
Private WithEvents mForm    As Access.Form

Private mbolColumnHeadingSortEnabled As Boolean
Private mbolColumnResizingEnabled As Boolean

Public ColumnLabels As New Collection ' A collection of label control names to reposition.

Private Sub ListColumnResizeMouseDown(listCtrl As Control, MouseButton As Integer, MouseX As Single, MouseY As Single)
'This sub is for the initial click of the click-and-drag.

    Dim i As Integer

    If MouseButton <> 1 Then Exit Sub 'If it is not a simple left click, we ignore it.

    If MouseY > 400 Then Exit Sub   ' Only let the columns resize if clicking dividers near the top of the list.
                                    ' BS 7/5/2016:  I was getting annoyed by this routine intercepting regular row clicks
                                    ' so this is a way to ignore the divider clicks lower in the list.
                                    ' MouseY of 400 is about two list rows of Tahoma 8.

    ' First we get the existing column widths and calculate where the divider lines should be.
    Dim colWidths, ColPositions
    colWidths = Split(listCtrl.ColumnWidths, ";")
    ColPositions = Split(listCtrl.ColumnWidths, ";")
    For i = 1 To UBound(colWidths)
        ColPositions(i) = CInt(ColPositions(i - 1)) + CInt(colWidths(i))
    Next i

    ' Then we see if the mouse is within the tolerance of a given divider line.
    For i = 0 To UBound(ColPositions)
        If (MouseX >= ColPositions(i) - ListResizeMouseTolerance) And (MouseX <= ColPositions(i) + ListResizeMouseTolerance) Then

            Debug.Print MouseX, MouseY

            Screen.MousePointer = 9 'change mouse pointer to "horizontal resize'
            IsColumnResizing = True 'trigger our private dragging variable
            ResizingColumn = i 'indicate which column we are changing
        End If
    Next i

End Sub

Private Sub ListColumnResizeMouseMove(listCtrl As Control, MouseButton As Integer, MouseX As Single)
' This sub takes care of mouse dragging.
' Unfrortunately after Access 2007 this event can no longer be called from the MouseMove event without
' crashing Access.  It is now called from the MouseUp event which limits the screen refresh.

    Dim i As Integer

    'if they've somehow released the mouse button, and we think we are resizing, then we stop resizing
    On Error GoTo ErrorHandler

    If IsColumnResizing And MouseButton <> 1 Then ListColumnResizeMouseUp

    'again we calculate the column widths and positions.
    Dim colWidths, oldWidths, ColPositions, newWidths
    colWidths = Split(listCtrl.ColumnWidths, ";")
    oldWidths = Join(colWidths, ";") 'this is just to compare with later, just in case Join gives us slightly different results than just taking the ColumnWidths property
    ColPositions = Split(listCtrl.ColumnWidths, ";")
    For i = 1 To UBound(colWidths)
        ColPositions(i) = CInt(ColPositions(i - 1)) + CInt(colWidths(i))
    Next i

    'The main resizing calculation:
    If IsColumnResizing = True Then 'Are they resizing?
        If MouseX < ColPositions(ResizingColumn) Then 'Are they moving it to the left?
            If ResizingColumn > 0 Then 'If it is not the furthest left column we are resizing...
                If MouseX > ColPositions(ResizingColumn - 1) Then 'Make sure it isn't going over the one to the left.
                    'Here we just calculate the size of the changed column by taking the difference between the divider
                    'and the mouse position and subtracting it from the original column size. Simple, no?
                    colWidths(ResizingColumn) = CInt(colWidths(ResizingColumn) - (ColPositions(ResizingColumn) - MouseX))
                End If
            Else 'If it IS the furthest left column we are resizing...
                If MouseX > 0 Then 'Then just make sure the size is going to be greater than zero
                    'Calculate the size again (same as before)
                    colWidths(ResizingColumn) = CInt(colWidths(ResizingColumn) - (ColPositions(ResizingColumn) - MouseX))
                End If
            End If
        Else 'If they aren't moving to the left, then they're moving to the right (or not moving at all, but we can ignore that)
            If ResizingColumn < UBound(ColPositions) Then 'If it not the furthest right column we are resizing...
                If MouseX < ColPositions(ResizingColumn + 1) Then 'Make sure it isn't running over the next column.
                    'Same calculation as before, except that the mouse position will be larger than the divider position,
                    'and we are expanding the column rather than shrinking it.
                    colWidths(ResizingColumn) = CInt(colWidths(ResizingColumn) + (MouseX - ColPositions(ResizingColumn)))
                End If
            Else 'If it IS the furthest right column we are resizing...
                If MouseX < listCtrl.Width Then 'Make sure we aren't going outside the control...
                    'Same expanding calculation as before
                    colWidths(ResizingColumn) = CInt(colWidths(ResizingColumn) + (MouseX - ColPositions(ResizingColumn)))
                End If
            End If
        End If
        newWidths = Join(colWidths, ";") 'Now we put the widths back together again, and...
        If newWidths <> oldWidths Then listCtrl.ColumnWidths = newWidths 'if it is a different result, then resize the columns.
    End If

    Exit Sub

ErrorHandler:

    MsgBox "Error #" & err.Number & " - " & err.Description & vbCrLf & "in procedure ListColumnResizeMouseMove of clsListboxColumnResize"

End Sub

Private Sub ListColumnResizeMouseUp()
'This sub takes care of releasing the mouse button.

    If Screen.MousePointer = 9 Then Screen.MousePointer = 0 'If the mouse is a horizontal-resizer, make it a regular pointer.
    If IsColumnResizing = True Then IsColumnResizing = False 'Indicate that we are no longer dragging.

    If ColumnLabels.count > 1 Then
        ' Reposition the column headings that were pass to SetupColumnLabels()
        '(Note that the first label never moves as it is the farthest left.)
        Dim i As Integer

        For i = 2 To ColumnLabels.count
            mListbox.Parent.Controls(ColumnLabels(i)).Left = DividerLeft(mListbox, i - 1)
        Next
    End If

End Sub

Private Function DividerLeft(listCtrl As Control, DividerNumber)
'This function just calculates where the left point of a column is relevant to the
'form as a whole. This is useful for moving labels along with columns.

    Dim colWidths, ColPositions
    Dim i As Integer

'    If IsColumnResizing Then '<- use this if calling from the MouseMove event to reduce overhead.

        colWidths = Split(listCtrl.ColumnWidths, ";")
        ColPositions = Split(listCtrl.ColumnWidths, ";")

        For i = 1 To UBound(colWidths)
            ColPositions(i) = CInt(ColPositions(i - 1)) + CInt(colWidths(i))
        Next i

        If DividerNumber > listCtrl.ColumnCount Then
            ' The DividerNumber is higher than the number of defined columns.
            ' Catch this instead of generating an error.  BS 4/3/2019
            DividerLeft = listCtrl.Left + listCtrl.Width - 1000
        Else
            DividerLeft = listCtrl.Left + ColPositions(DividerNumber - 1)
        End If

        ' Don't let the label move too far.
        If DividerLeft > (listCtrl.Left + listCtrl.Width) Then
            DividerLeft = listCtrl.Left + listCtrl.Width
        End If
'    End If

End Function


'--------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()

    mbolColumnResizingEnabled = True
    mbolColumnHeadingSortEnabled = False

End Sub

Private Sub Class_Terminate()

    Set mListbox = Nothing
    Set mForm = Nothing

End Sub


Public Sub SetupListbox(ctlListbox As Access.ListBox)

    ' Save a local reference
    Set mListbox = ctlListbox

' This IS necessary.  If you don't have this and change from form view to design view Access will crash.  BS 11/8/2016
'''' This may not be necessary.  If this class doesn't open any objects we may not need to cleanup.
'    Set mForm = Forms("frm_Hex").Form
'    Set mForm = ctlListbox.Parent.Parent.Parent
    Set mForm = fGetParentForm(ctlListbox)      ' Use this function to get the parent form in case the control is on a tab control.
    mForm.OnClose = "[Event Procedure]"         ' For proper termination.

    mListbox.OnMouseDown = EnableEvents
    mListbox.OnMouseMove = EnableEvents
    mListbox.OnMouseUp = EnableEvents

    If mListbox.ColumnHeads = True Then
        ' If this list has column headings enabled, enable the column heading sort feature as the default.
        mbolColumnHeadingSortEnabled = True
    End If

    ' If we access the ListIndex property
    ' then the entire Index for the RowSource
    ' behind each ListBox is loaded.
    ' Allows for smoother initial scrolling.
    Dim lngTemp As Long
    lngTemp = mListbox.ListCount

End Sub

Public Sub SetupColumnLabels(ParamArray arryLabelControls())
' Pass in the column label controls so they are repositioned above each list column as it is resized.
' Example call:  ListboxColumnResize.SetupColumnLabels lblCode, lblItem, lblName
' YMMV.  This doesn't account for hidden columns or columns with no label control, or overlapping.
' If you have a hidden column with no heading, like when column 0 is hidden, just pass the next visible
' column heading label twice in a row.

    Dim i As Integer

    ' Store the passed control names into a collection.
    For i = 0 To UBound(arryLabelControls)
        ColumnLabels.Add arryLabelControls(i).Name
    Next

End Sub



Property Let EnableColumnHeadingSort(bolEnable As Boolean)

    On Error GoTo ErrorHandler

    If mListbox Is Nothing Then
        MsgBox "The program tried to set a property without calling SetupListbox first.", vbExclamation, "Warning from clsListboxColumnResize"
    ElseIf mListbox.ColumnHeads = False And bolEnable = True Then
        ' Ignore this
        MsgBox "The program tried to enable Column Heading Sort in listbox '" & mListbox.Name & "' but column headings are not visible.", vbExclamation, "Warning from clsListboxColumnResize"
    Else
        mbolColumnHeadingSortEnabled = bolEnable
    End If

    Exit Property

ErrorHandler:

    MsgBox "Error #" & err.Number & " - " & err.Description & vbCrLf & "in procedure EnableColumnHeadingSort of clsListboxColumnResize"

End Property

Property Let EnableColumnResizing(bolEnable As Boolean)
' This property is assumed to be true when using this class but give the
' user the ability to disable it if they need to for some other operation.
    mbolColumnResizingEnabled = bolEnable

End Property

Property Get EnableColumnResizing() As Boolean

    EnableColumnResizing = mbolColumnResizingEnabled

End Property

Private Sub mListbox_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    ListColumnResizeMouseDown mListbox, Button, x, y

    If IsColumnResizing Then
        ' Don't sort when in column resize mode.
    Else
        ' Sort list when column heading is clicked.
        sColumnHeadingClickSort mListbox, Button, Shift, x, y
    End If
End Sub

Private Sub mListbox_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If IsColumnResizing Then
        ListColumnResizeMouseMove mListbox, Button, x
        ListColumnResizeMouseUp
    End If
End Sub



'-------------------------------------


Private Sub sColumnHeadingClickSort(objList As ListBox, MouseButton As Integer, Shift As Integer, x As Single, y As Single)
' Attempt to sort when column heading is clicked.  I couldn't find anyone on the Internet
' who has done this before.  Call this from the MouseDown event.
'
' This sorts by updating OrderBy in the rowsource of the listbox, causing a requery.
' I did consider sorting the DAO recordset that is already in the listbox but Microsoft
' documentation suggested that it may not be any faster, and another article suggested
' that a requery is still necessary with a DAO sort.
'
' Ben Sacherich - 7/13/2014
' BS 8/10/2014: Updated the secondary sort to be copied properly.
' BS 3/8/2016:  Changed this to be its own sub.
' BS 3/28/2016: Changed to be part of this class.
' BS 8/4/2016:  Added ability to sort if column headings are not visible but user shift-clicks in the top row.

    Dim strNewOrder         As String
    Dim strColumn           As String
    Static strDirection     As String  ' Direction of sort, Ascending or Descending
    Static strPrevColumn    As String  ' Preserve the previous click for sort stacking.
    Static strSecondarySort As String  ' Preserve the secondary sort.

    On Error GoTo ErrorHandler

    If MouseButton <> 1 Then Exit Sub 'If it is not a simple left click, we ignore it.

    If (objList.ColumnHeads = False) And (Shift = 1) And (y < 200) Then
        ' When column heads are not visible let the user shift-click in
        ' the first row to sort by that column.
        strColumn = fGetColumnHeadingClicked(objList, x, y, True)
    Else
        strColumn = fGetColumnHeadingClicked(objList, x, y)
    End If

    If strColumn <> "" Then ' It appears that a column heading has been clicked.

        If strPrevColumn = "" Then
            ' This is the first time a column was selected.
            strSecondarySort = strColumn

        ElseIf strColumn = strPrevColumn Then
            ' Same column heading selected twice.  Change the sort direction.
            If strDirection = " Desc" Then
                ' Change back to Ascending (or just leave it blank)
                strDirection = ""
            Else
                strDirection = " Desc"
            End If

        Else
            ' Another column was selected.  The previous column will be the secondary sort and the new column will be Ascending.
            strSecondarySort = strPrevColumn & strDirection

            ' Always set the direction to Ascending when a new column is clicked
            strDirection = ""

        End If

        strNewOrder = "ORDER BY " & strColumn & strDirection & ", " & strSecondarySort

'        txtOrderBy = strNewOrder ' Update the barely visible text box on the screen.
        objList.StatusBarText = strNewOrder ' Update the status bar text for the listbox to show the current sort.


'        Debug.Print strNewOrder
        objList.RowSource = ReplaceOrderByClause(objList.RowSource, strNewOrder)
        strPrevColumn = strColumn
    End If

    Exit Sub

ErrorHandler:

    MsgBox "Error #" & err.Number & " - " & err.Description & vbCrLf & "in procedure sColumnHeadingClickSort of Form_frm_dialog_Quick_Search"

End Sub


Private Function fGetColumnHeadingClicked(oList As Object, x As Single, y As Single, Optional ColumnHeadOverride As Boolean = False) As String
' Return the column heading number of the column clicked.
' This could return the column heading name but the number is more useful for an Order By statement.
' Ben Sacherich 7/13/2014
' BS 8/4/2016:  Added optional ColumnHeadOverride parameter to support lists without column headings.

    Dim lColumn As Long
    Dim arryColumnWidths() As String
    Dim lngTwipsFromLeft As Long

    On Error GoTo ErrorHandler

    If ((oList.ColumnHeads = True) And (y < 200)) Or (ColumnHeadOverride = True) Then
        ' User clicked in the area of the column heading.
        ' You may have to adjust the Y value for your font size.

        ' Find out which column they clicked on.
        ' The neat thing about this is the .ColumnWidths is returned in Twips.
        arryColumnWidths = Split(oList.ColumnWidths, ";")

        For lColumn = LBound(arryColumnWidths) To UBound(arryColumnWidths)
            lngTwipsFromLeft = lngTwipsFromLeft + arryColumnWidths(lColumn)
            If x < lngTwipsFromLeft Then
'                Debug.Print "[" & oList.Column(lColumn, 0) & "]", lColumn
'                fGetColumnHeadingClicked = "[" & oList.Column(lColumn, 0) & "]"
                fGetColumnHeadingClicked = lColumn + 1
                Exit For
            End If
        Next

    End If

    Exit Function

ErrorHandler:
    MsgBox "Error #" & err.Number & " - " & err.Description & vbCrLf & "in Function fGetColumnHeadingClicked()"

End Function


'=========================================================================================================
' BS 3/28/2016:  The code below was copied into this class so the class is independent and can be shared.
'=========================================================================================================


' You may use the code and techniques in this database as long as you do not publish
' as your own work; this copyright notice must remain complete and intact.
'
' www.JStreetTech.com
' Copyright © 2000 J Street Technology, Inc.  All Rights Reserved.


Private Sub ParseSQL(strSQL As Variant, strSELECT As Variant, strWHERE As Variant, strORDERBY As Variant, strGROUPBY As Variant, strHAVING As Variant)
On Error GoTo Err_ParseSQL
'12/4/95  CM            Created
'2/15/96  Armen Stein   Converted to Sub from Function
'10/27/97 Armen Stein   Added GroupBy capability
'5/13/2014 Ben Sacherich    Added support for strSQL input being a Query object.
'5/22/2014 Ben Sacherich    If this routine is called from within a loop and parameters 2-6 get old values
'                           passed in, this was returning those old values. It will now clear those values
'                           when starting.
'Limitations:
'   This does not properly handle UNION queries.
'
'This subroutine accepts a valid SQL string and passes back separated SELECT, WHERE, ORDER BY and GROUP BY clauses.
'
'INPUT:
'    strSQL      valid SQL string or Query Object name to parse
'OUTPUT:
'    strSELECT   SELECT portion of SQL (includes JOIN info)
'    strWHERE    WHERE portion of SQL
'    strORDERBY  ORDER BY portion of SQL
'    strGROUPBY  GROUP BY portion of SQL
'    strHAVING   HAVING portion of SQL
'
'Note:  While the subroutine will accept the ';' character in strSQL,
'       there is no ';' character passed back at any time.
'       BS 5/22/2014: Note that the ';' is now ignored because it did not handle
'       PARAMETERS or intentionally embedded semicolons.
'

    Dim intStartSELECT As Integer
    Dim intStartWHERE As Integer
    Dim intStartORDERBY As Integer
    Dim intStartGROUPBY As Integer
    Dim intStartHAVING As Integer

    Dim intLenSELECT As Integer
    Dim intLenWHERE As Integer
    Dim intLenORDERBY As Integer
    Dim intLenGROUPBY As Integer
    Dim intLenHAVING As Integer

    Dim intLenSQL As Integer

    ' Clear the values so if they had data when they were passed in,
    ' it would not be returned.  BS 5/22/2014
    strSELECT = ""
    strWHERE = ""
    strORDERBY = ""
    strGROUPBY = ""
    strHAVING = ""

    intStartSELECT = InStr(strSQL, "SELECT ")

    If intStartSELECT = 0 Then
        ' This may be a query object instead of a SQL statement.  BS 5/13/2014
        If CurrentDb.QueryDefs(strSQL).Name <> "" Then
            ' This is a QueryDef.  Retrieve the SQL from it.
            strSQL = CurrentDb.QueryDefs(strSQL).SQL
            intStartSELECT = InStr(strSQL, "SELECT ")
        End If
    End If

    intStartWHERE = InStr(strSQL, "WHERE ")
    intStartORDERBY = InStr(strSQL, "ORDER BY ")
    intStartGROUPBY = InStr(strSQL, "GROUP BY ")
    intStartHAVING = InStr(strSQL, "HAVING ")

    'if there's no GROUP BY, there can't be a HAVING
    If intStartGROUPBY = 0 Then
        intStartHAVING = 0
    End If


    ' BS 5/22/2014:  If the passed query has parameters, the PARAMETER statement will end with ';'.
    ' The following condition was removing everything after the ';' so I have commented out this feature.
    ' The following code would only respond to the first ';' found, even if it was embedded as part of
    ' static text in the SQL statement.
    If InStr(strSQL, ";") Then       'if it exists, trim off the ';'
        strSQL = Left(strSQL, InStr(strSQL, ";") - 1)
    End If

    intLenSQL = Len(strSQL)

    ' find length of Select portion
    If intStartSELECT > 0 Then
        ' start with longest it could be
        intLenSELECT = intLenSQL - intStartSELECT + 1
        If intStartWHERE > 0 And intStartWHERE > intStartSELECT And intStartWHERE < intStartSELECT + intLenSELECT Then
            'we found a new portion closer to this one
            intLenSELECT = intStartWHERE - intStartSELECT
        End If
        If intStartORDERBY > 0 And intStartORDERBY > intStartSELECT And intStartORDERBY < intStartSELECT + intLenSELECT Then
            'we found a new portion closer to this one
            intLenSELECT = intStartORDERBY - intStartSELECT
        End If
        If intStartGROUPBY > 0 And intStartGROUPBY > intStartSELECT And intStartGROUPBY < intStartSELECT + intLenSELECT Then
            'we found a new portion closer to this one
            intLenSELECT = intStartGROUPBY - intStartSELECT
        End If
        If intStartHAVING > 0 And intStartHAVING > intStartSELECT And intStartHAVING < intStartSELECT + intLenSELECT Then
            'we found a new portion closer to this one
            intLenSELECT = intStartHAVING - intStartSELECT
        End If
    End If

    ' find length of GROUPBY portion
    If intStartGROUPBY > 0 Then
        ' start with longest it could be
        intLenGROUPBY = intLenSQL - intStartGROUPBY + 1
        If intStartWHERE > 0 And intStartWHERE > intStartGROUPBY And intStartWHERE < intStartGROUPBY + intLenGROUPBY Then
            'we found a new portion closer to this one
            intLenGROUPBY = intStartWHERE - intStartGROUPBY
        End If
        If intStartORDERBY > 0 And intStartORDERBY > intStartGROUPBY And intStartORDERBY < intStartGROUPBY + intLenGROUPBY Then
            'we found a new portion closer to this one
            intLenGROUPBY = intStartORDERBY - intStartGROUPBY
        End If
        If intStartHAVING > 0 And intStartHAVING > intStartGROUPBY And intStartHAVING < intStartGROUPBY + intLenGROUPBY Then
            'we found a new portion closer to this one
            intLenGROUPBY = intStartHAVING - intStartGROUPBY
        End If
    End If

    ' find length of HAVING portion
    If intStartHAVING > 0 Then
        ' start with longest it could be
        intLenHAVING = intLenSQL - intStartHAVING + 1
        If intStartWHERE > 0 And intStartWHERE > intStartHAVING And intStartWHERE < intStartHAVING + intLenHAVING Then
            'we found a new portion closer to this one
            intLenHAVING = intStartWHERE - intStartHAVING
        End If
        If intStartORDERBY > 0 And intStartORDERBY > intStartHAVING And intStartORDERBY < intStartHAVING + intLenHAVING Then
            'we found a new portion closer to this one
            intLenHAVING = intStartORDERBY - intStartHAVING
        End If
        If intStartGROUPBY > 0 And intStartGROUPBY > intStartHAVING And intStartGROUPBY < intStartHAVING + intLenHAVING Then
            'we found a new portion closer to this one
            intLenHAVING = intStartGROUPBY - intStartHAVING
        End If
    End If


    ' find length of ORDERBY portion
    If intStartORDERBY > 0 Then
        ' start with longest it could be
        intLenORDERBY = intLenSQL - intStartORDERBY + 1
        If intStartWHERE > 0 And intStartWHERE > intStartORDERBY And intStartWHERE < intStartORDERBY + intLenORDERBY Then
            'we found a new portion closer to this one
            intLenORDERBY = intStartWHERE - intStartORDERBY
        End If
        If intStartGROUPBY > 0 And intStartGROUPBY > intStartORDERBY And intStartGROUPBY < intStartORDERBY + intLenORDERBY Then
            'we found a new portion closer to this one
            intLenORDERBY = intStartGROUPBY - intStartORDERBY
        End If
        If intStartHAVING > 0 And intStartHAVING > intStartORDERBY And intStartHAVING < intStartORDERBY + intLenORDERBY Then
            'we found a new portion closer to this one
            intLenORDERBY = intStartHAVING - intStartORDERBY
        End If
    End If

    ' find length of WHERE portion
    If intStartWHERE > 0 Then
        ' start with longest it could be
        intLenWHERE = intLenSQL - intStartWHERE + 1
        If intStartGROUPBY > 0 And intStartGROUPBY > intStartWHERE And intStartGROUPBY < intStartWHERE + intLenWHERE Then
            'we found a new portion closer to this one
            intLenWHERE = intStartGROUPBY - intStartWHERE
        End If
        If intStartORDERBY > 0 And intStartORDERBY > intStartWHERE And intStartORDERBY < intStartWHERE + intLenWHERE Then
            'we found a new portion closer to this one
            intLenWHERE = intStartORDERBY - intStartWHERE
        End If
        If intStartHAVING > 0 And intStartHAVING > intStartWHERE And intStartHAVING < intStartWHERE + intLenWHERE Then
            'we found a new portion closer to this one
            intLenWHERE = intStartHAVING - intStartWHERE
        End If
    End If

    ' set each output portion
    If intStartSELECT > 0 Then
        strSELECT = Mid$(strSQL, intStartSELECT, intLenSELECT)
    End If
    If intStartGROUPBY > 0 Then
        strGROUPBY = Mid$(strSQL, intStartGROUPBY, intLenGROUPBY)
    End If
    If intStartHAVING > 0 Then
        strHAVING = Mid$(strSQL, intStartHAVING, intLenHAVING)
    End If
    If intStartORDERBY > 0 Then
        strORDERBY = Mid$(strSQL, intStartORDERBY, intLenORDERBY)
    End If
    If intStartWHERE > 0 Then
        strWHERE = Mid$(strSQL, intStartWHERE, intLenWHERE)
    End If

Exit_ParseSQL:
    Exit Sub

Err_ParseSQL:
    If err.Number = 3265 Then ' NAME_NOT_IN_COLLECTION (QueryDef not found)
        Resume Next
    Else
        MsgBox Error.Number & ": " & Error.Description
        Resume Exit_ParseSQL
    End If
End Sub


Private Function ReplaceOrderByClause(strSQL As Variant, strNewOrder As Variant) As String
' 7/14/2014 - Ben Sacherich
'
'This subroutine accepts a valid SQL string and ORDER BY clause, and
'returns the same SQL statement with the original Order By clause (if any)
'replaced by the passed in Order By clause.
'
'INPUT:
'    strSQL      valid SQL string to change
'OUTPUT:
'    strNewORDER New Order By clause to insert into SQL statement
'

    Dim strSELECT As String, strWHERE As String, strORDERBY As String, strGROUPBY As String, strHAVING As String

    On Error GoTo ErrorHandler

    Call ParseSQL(strSQL, strSELECT, strWHERE, strORDERBY, strGROUPBY, strHAVING)

'    If strORDERBY = "" Then
'        strNewORDER = vbCrLf & " ORDER BY " & strNewORDER
'    End If

    ReplaceOrderByClause = strSELECT & " " & strWHERE & " " & strGROUPBY & " " & strHAVING & " " & strNewOrder

Exit_Function:
    Exit Function
ErrorHandler:
    MsgBox err.Number & ", " & err.Description
    Resume Exit_Function
End Function

Private Sub mForm_Close()
' By tapping into the form events FROM the class, I can tap into the close event
' so I don't need to have the cleanup code in the form. "cleaner" that way I think. -TSC

    Call Class_Terminate

End Sub

Private Function fGetParentForm(ctl As Control) As Object
' Return the Parent Form object of the passed control.  Normally this
' is ctl.Parent, but could be different if the control is on a tab control.
' BS 7/5/2016

    Dim obj As Object

    Set obj = ctl
    While Not (obj Is Nothing)
        If TypeOf obj.Parent Is Form Then
            Set fGetParentForm = obj.Parent
            Set obj = Nothing ' To clear the memory used by this.
            Exit Function
        Else
            Set obj = obj.Parent
        End If
    Wend

End Function