More Regex Functions

And finally, I’m back! I finally overcame the inertia yesterday and got back to work on the regular expressions add-in. The next goal is to include regular expressions equivalents for Excel’s built-in advanced filter and find/replace functions. So far I’ve concentrated on just the filter part, which I hope to have finished fairly soon. However as there’s a fair amount of code involved, I’ll split this into 2 or 3 posts.

Firstly, the advanced filter dialog. Not being a big fan of re-inventing the wheel I decided to build pretty much exactly the same form as you find Excel presenting you with for an ordinary advanced filter. Here’s what my version looks like:

 

All that this form needs to do is collect 3 key pieces of information to control the filter process:

  1. What ranges will the filter operate on?
  2. Will the source range (List Range) be filtered in place, or will the filtered results be copied to another place (Copy to)?
  3. Does the filtered list need to display unique records only?

Here’s the code behind the form. The public properties List, Criteria and Extract return the addresses for the ranges in (1) from the RefEdit controls, and the booleans CopyTo and UniqueOnly return the values for (2) and (3) respectively.

Option Explicit

Private mbOK As Boolean

'**********************************************************
' Form class public properties
'**********************************************************

' User clicked OK
Public Property Get OK() As Boolean
    OK = mbOK
End Property
'**********************************************************
' Ranges selected for filter
'**********************************************************
Public Property Get List() As String
' List range to be filtered
    List = refList.Value
End Property

Public Property Get Criteria() As String
' Range containing criteria for filter
    Criteria = refCriteria.Value
End Property

Public Property Get Extract() As String
' Range to copy filtered rows to
    Extract = refExtract.Value
End Property

'**********************************************************
' Properties modifying filter operation
'**********************************************************

' User selected Copy to range option button
Public Property Get CopyTo() As Boolean
    CopyTo = optCopy.Value
End Property

' User selected Unique values only checkbox
Public Property Get UniqueOnly() As Boolean
    UniqueOnly = chkUnique.Value
End Property

'**********************************************************
' Form controls
'**********************************************************
Private Sub cmdCancel_Click()
    mbOK = False
    Me.Hide
End Sub

Private Sub cmdOk_Click()
    mbOK = True
    Me.Hide
End Sub

Private Sub optCopy_Click()
    
    ' enable refExtract
    lblExtract.ForeColor = vbButtonText
    With refExtract
        .Enabled = True
        .BackColor = vbWindowBackground
    End With
    
End Sub

Private Sub optInPlace_Click()

    ' grey out and disable refExtract
    lblExtract.ForeColor = vbGrayText
    With refExtract
        .Enabled = False
        .BackColor = vbInactiveCaptionText
    End With
    
End Sub

Private Sub UserForm_Initialize()

    ' Set default values for List range and optInPlace
    refList.Value = Application.ActiveCell.CurrentRegion.Address
    optInPlace.Value = True

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If CloseMode = vbFormControlMenu Then
        cmdCancel_Click
        Cancel = True
    End If

End Sub

And here’s the sub GetRanges, which ‘reads’ the form:

Private Sub GetRanges(ByRef rngSource As Excel.Range, _
                ByRef rngCriteria As Excel.Range, _
                ByRef rngExtract As Excel.Range, _
                ByRef bUnique As Boolean)
                
    Dim frmFilter As FRXFilter

    Set frmFilter = New FRXFilter
    frmFilter.Show
    
    If frmFilter.OK Then
        With frmFilter
            If .List <> "" Then _
                Set rngSource = Range(.List)
            If .Criteria <> "" Then _
                Set rngCriteria = Range(.Criteria)
            If .CopyTo Then _
                Set rngExtract = Range(.Extract)
            bUnique = .UniqueOnly
        End With
    End If
                
End Sub

I also want to include some error-handling to cope with bad range addresses, but apart from that it’s pretty much there. Next time I’ll post the sub at the next level up, calling GetRanges and a couple of other routines to perform the filtering.

Advertisements