5
\$\begingroup\$

The Task

A task I've been given recently is to design a data entry form which transfers data from the form to a table on a worksheet.
Depending on the answers given to various questions, other questions are displayed or hidden. For the most part I've achieved this by using different forms.
There is one route that requires a single form to ask too many questions to sit comfortably on the screen, so on my first build I figured out what I needed and am now working on various refactoring exercises.

What the code does

The class I've written handles the positioning and visibility of frames on the form. Frames added at design time can be moved, hidden or shown without ending up with empty spaces in the middle of the form. It only handles a single column of frames, so haven't added code where two frames might have the same Top value. When the class is initialised it makes a dictionary of all top level (that have the form as a parent) frames on the form.

Set FrameSorter = New cFrameSorter
FrameSorter.Initialise Me

These frames can then be removed or added to the form, where they'll appear beneath the last visible frame. Their position on the form can be moved up, down or to a specified position.

FrameSorter.AddFrame Me.Frame1
FrameSorter.MoveUp Me.Frame1
FrameSorter.Move Me.Frame1, 2
FrameSorter.Remove Me.Frame1  

Review

Open to all suggested improvements. Naming conventions, order of procedures, sub, function or property? Should I use an interface (never used one before), any ideas on how to have a subclass looking at frames within frames?
I know I haven't included any error handling yet - it's a first draft, so wanted to see all errors and handle the ones I could.

The Code

To use the code:

  • Create a class named cFrameSorter
  • Create a userform and add these controls:
    • a combobox named cmbFrames
    • a texbox named txtPosition
    • 5 command buttons named: cmdMoveFrame, cmdShowFrame, cmdHideFrame, cmdMoveFrameUp and cmdMoveFrameDown.
    • A few frames. The names don't matter and frames within frames will be ignored. Have a few visible and a few not.

When the form opens it will populate the combo box with a list of frames - select a frame and click show/hide/up/down or add a number to the text box and click move.

Add this code to the class module:

Option Explicit

'FrameDictionary contains all frames that have the form as the parent.
'VisibleFrames contain all frames within FrameDictionary that have a
'True Visible property in the order they appear.

Private FrameDictionary As Dictionary
Private VisibleFrames As Dictionary
Private pStartPosition As Long
Private pSpacer As Long

Private Sub Class_Initialize()
    Set FrameDictionary = New Dictionary
    Set VisibleFrames = New Dictionary
    Me.StartPosition = 6
    Me.Spacer = 10
End Sub

'The position of the first frame on the form.
Public Property Get StartPosition() As Long
    StartPosition = pStartPosition
End Property
Public Property Let StartPosition(Value As Long)
    pStartPosition = IIf(Value >= 0, Value, 0)
End Property

'This is the distance between frames.
Public Property Get Spacer() As Long
    Spacer = pSpacer
End Property
Public Property Let Spacer(Value As Long)
    pSpacer = IIf(Value >= 0, Value, 0)
End Property

'This property would not normally exist.
'It exists to populate the combo box on the UserForm.
Public Property Get FrameDict() As Dictionary
    Set FrameDict = FrameDictionary
End Property

'Adds a frame to the VisibleFrames dictionary providing
'it exists within the FrameDictionary. The frames Visible
'property is set to TRUE and it will appear beneath
'the last visible frame.
Public Sub AddFrame(SourceFrame As Frame)
    If Not SourceFrame Is Nothing Then
        If FrameDictionary.Exists(SourceFrame.Name) Then
            With SourceFrame
                If Not VisibleFrames.Exists(.Name) Then
                    .Visible = True
                    VisibleFrames.Add .Name, SourceFrame
                    ArrangeFrames
                End If
            End With
        End If
    End If
End Sub

'The frame is removed from the VisibleFrames dictionary.
'The frames Visible property is set to FALSE and the
'remaining visible frames are rearranged to close any
'gaps left.
Public Sub RemoveFrame(SourceFrame As Frame)
    If Not SourceFrame Is Nothing Then
        With SourceFrame
            If VisibleFrames.Exists(.Name) Then
                .Visible = False
                VisibleFrames.Remove (.Name)
                ArrangeFrames
            End If
        End With
    End If
End Sub

Public Sub MoveUp(SourceFrame As Frame, Optional Position As Long = 1)
    Dim lPosition As Long
    lPosition = GetPositionInDict(SourceFrame)
    If lPosition > 1 Then
        MoveFrame SourceFrame, lPosition - 1
        ArrangeFrames
    End If
End Sub

Public Sub MoveDown(SourceFrame As Frame, Optional Position As Long = 1)
    Dim lPosition As Long
    lPosition = GetPositionInDict(SourceFrame)
    If lPosition > 0 And lPosition < VisibleFrames.Count Then
        MoveFrame SourceFrame, lPosition + 1
        ArrangeFrames
    End If
End Sub

Public Sub Move(SourceFrame As Frame, Position As Long)
    MoveFrame SourceFrame, Position
    ArrangeFrames
End Sub

'Looks at each frame on the SourceForm.  Any that have
'the form as a parent rather than another frame is added
'to the FrameDictionary.  These represent the top level frames.
'
'As frames are looked at in the order they were added to the
'form the FrameDictionary is sorted using the Top property of
'each frame.
'
'Any frames with a TRUE visible property at design time are
'added to the VisibleFrames dictionary and are displayed in
'order when the form first opens.
Public Sub Initialise(SourceForm As Object)
    Dim ctrl As Control
    Dim tmpSubSorter As cFrameSorter
    Dim vSortArray As Variant
    For Each ctrl In SourceForm.Controls
        If TypeName(ctrl) = "Frame" Then
            Select Case TypeName(ctrl.Parent)
                Case TypeName(SourceForm)
                    With FrameDictionary
                        If Not .Exists(ctrl.Name) Then
                            .Add ctrl.Name, ctrl
                        End If
                    End With
                Case "Frame"
                    'Do nothing yet.
            End Select
        End If
    Next ctrl
    'Sort the frames contained in the dictionary into
    'order based on their Top property.
    vSortArray = FrameDictToArray(FrameDictionary)
    Sort2DArray vSortArray
    SortDictByArray vSortArray, FrameDictionary
    'Create a dictionary of visible frames and then
    'arrange them on the form in order.
    GetVisibleFrames
    ArrangeFrames
End Sub

'Returns the ordinal position of a frame within the VisibleFrames dictionary.
'If the frame doesn't exist within the dictionary -1 is returned.
Private Function GetPositionInDict(SourceFrame As Frame) As Long
    Dim vItem As Variant
    Dim x As Long
    If Not SourceFrame Is Nothing Then
        If VisibleFrames.Exists(SourceFrame.Name) Then
            For Each vItem In VisibleFrames.Items
                x = x + 1
                If SourceFrame.Name = vItem.Name Then
                    GetPositionInDict = x
                    Exit For
                End If
            Next vItem
        Else
            GetPositionInDict = -1
        End If
    End If
End Function

'Populates the VisibleFrames dictionary with frames
'from the FrameDictionary that have a TRUE visible property.
Private Sub GetVisibleFrames()
    Dim tmpDict As Dictionary
    Dim vItem As Variant
    If Not FrameDictionary Is Nothing Then
        If FrameDictionary.Count > 0 Then
            Set tmpDict = New Dictionary
            For Each vItem In FrameDictionary.Items
                If vItem.Visible Then
                    tmpDict.Add vItem.Name, vItem
                End If
            Next vItem
        End If
    End If
    Set VisibleFrames = tmpDict
End Sub

'Moves a frames position within the VisibleFrames dictionary,
'to a specified position.
'If the required position is higher or lower than the number
'of frames then the highest or lowest value is used.
Private Sub MoveFrame(SourceFrame As Frame, Position As Long)
    Dim tmpDict As Dictionary
    Dim vItem As Variant
    Dim x As Long
    If Not SourceFrame Is Nothing Then
        Set tmpDict = New Dictionary
        SourceFrame.Visible = True
        If Not VisibleFrames.Exists(SourceFrame.Name) Then
            VisibleFrames.Add SourceFrame.Name, SourceFrame
        End If
        If Position > VisibleFrames.Count Then
            Position = VisibleFrames.Count
        ElseIf Position < 0 Then
            Position = 0
        End If
        If Position = VisibleFrames.Count Then
            VisibleFrames.Remove SourceFrame.Name
            VisibleFrames.Add SourceFrame.Name, SourceFrame
        Else
            VisibleFrames.Remove SourceFrame.Name
            For x = 0 To VisibleFrames.Count - 1
                If x = Position - 1 Then
                    tmpDict.Add SourceFrame.Name, SourceFrame
                End If
                tmpDict.Add VisibleFrames.Items(x).Name, VisibleFrames.Items(x)
            Next x
            Set VisibleFrames = tmpDict
        End If
    End If
End Sub

'Positions the frames contained within the VisibleFrames dictionary on the
'parent form in the order they occur within the dictionary.
Private Sub ArrangeFrames()
    Dim vItem As Variant
    Dim lTopRow As Long
    If Not VisibleFrames Is Nothing Then
        If VisibleFrames.Count > 0 Then
            lTopRow = Me.StartPosition
            For Each vItem In VisibleFrames.Items
                vItem.Top = lTopRow
                lTopRow = lTopRow + vItem.Height + Me.Spacer
            Next vItem
        End If
    End If
End Sub

'Sorts TargetDict dictionary in the order of the array.
'The vSortArray holds the frame names
Private Sub SortDictByArray(vSortArray As Variant, TargetDict As Dictionary)
    Dim tmpDict As Dictionary
    Dim vItem As Variant
    Dim x As Long
    If Not TargetDict Is Nothing Then
        If UBound(vSortArray) = TargetDict.Count - 1 Then
            Set tmpDict = New Dictionary
            For x = LBound(vSortArray) To UBound(vSortArray)
                tmpDict.Add vSortArray(x, 1), TargetDict.Item(vSortArray(x, 1))
            Next x
            Set TargetDict = tmpDict
        End If
    End If
End Sub

'Takes the frame Top property and frame name to create
'an array from the SourceDictionary items.
Private Function FrameDictToArray(SourceDict As Dictionary) As Variant
    Dim tmpDict As Dictionary
    Dim x As Long
    Dim tmpArr As Variant
    Dim itm As Variant
    If Not SourceDict Is Nothing Then
        If SourceDict.Count > 0 Then
            Set tmpDict = New Dictionary
            ReDim tmpArr(0 To SourceDict.Count - 1, 0 To 1)
            For Each itm In SourceDict.Items
                tmpArr(x, 0) = itm.Top
                tmpArr(x, 1) = itm.Name
                x = x + 1
            Next itm
            FrameDictToArray = tmpArr
        End If
    End If
End Function

'Sorts the array using the frames Top property.
Private Sub Sort2DArray(vArray As Variant, _
    Optional ByVal lLowStart As Long = -1, _
    Optional ByVal lHighStart As Long = -1)

    Dim vPivot As Variant
    Dim lLow As Long
    Dim lHigh As Long

    lLowStart = IIf(lLowStart = -1, LBound(vArray), lLowStart)
    lHighStart = IIf(lHighStart = -1, UBound(vArray), lHighStart)
    lLow = lLowStart
    lHigh = lHighStart

    vPivot = vArray((lLowStart + lHighStart) \ 2, 0)
    While lLow <= lHigh
        While (vArray(lLow, 0) < vPivot And lLow < lHighStart)
            lLow = lLow + 1
        Wend

        While (vPivot < vArray(lHigh, 0) And lHigh > lLowStart)
            lHigh = lHigh - 1
        Wend

        If (lLow <= lHigh) Then
            Swap vArray, lLow, lHigh
            lLow = lLow + 1
            lHigh = lHigh - 1
        End If
    Wend

    If (lLowStart < lHigh) Then
        Sort2DArray vArray, lLowStart, lHigh
    End If
    If (lLow < lHighStart) Then
        Sort2DArray vArray, lLow, lHighStart
    End If

End Sub

Private Sub Swap(vArray As Variant, lItem1 As Long, lItem2 As Long)
    Dim vTemp0 As Variant
    Dim vTemp1 As Variant
    vTemp0 = vArray(lItem1, 0)
    vTemp1 = vArray(lItem1, 1)
    vArray(lItem1, 0) = vArray(lItem2, 0)
    vArray(lItem1, 1) = vArray(lItem2, 1)
    vArray(lItem2, 0) = vTemp0
    vArray(lItem2, 1) = vTemp1
End Sub

Add this code to the form:

Option Explicit

Private FrameSorter As cFrameSorter

Private Sub UserForm_Initialize()
    Dim vItem As Variant

    Set FrameSorter = New cFrameSorter
    FrameSorter.Initialise Me

    'Populate the combobox.
    For Each vItem In FrameSorter.FrameDict.Items
        Me.cmbFrames.AddItem vItem.Name
    Next vItem

End Sub

Private Sub cmdHideFrame_Click()
    FrameSorter.RemoveFrame Me.Controls(Me.cmbFrames.Value)
End Sub

Private Sub cmdMoveFrame_Click()
    FrameSorter.Move Me.Controls(Me.cmbFrames.Value), CLng(Me.txtPosition)
End Sub

Private Sub cmdMoveFrameDown_Click()
    FrameSorter.MoveDown Me.Controls(Me.cmbFrames.Value)
End Sub

Private Sub cmdMoveFrameUp_Click()
    FrameSorter.MoveUp Me.Controls(Me.cmbFrames.Value)
End Sub

Private Sub cmdShowFrame_Click()
    FrameSorter.AddFrame Me.Controls(Me.cmbFrames.Value)
End Sub
\$\endgroup\$
  • \$\begingroup\$ Read About Class Modules and the other post and your knowledge will increase (try the addin too). Also riptutorial.com shows why to avoid Hungarian Notation (yours just one char but usually unwanted) and many other tipps!. \$\endgroup\$ – ComputerVersteher Feb 6 at 1:47
  • 1
    \$\begingroup\$ Thanks for your feedback @ComputerVersteher. I'd love to install RubberDuck, but I only have my work laptop at the moment and they won't let me - hopefully that might change soon. I do get the point with naming variables after what they're used for, not what data type they are. I guess that's just a bad habit which I'm trying to get out of - I'm down to one character per variable. Bit like smoking I guess - I'm down to one a day on that too. :) \$\endgroup\$ – Darren Bartrup-Cook Feb 6 at 8:51
  • \$\begingroup\$ Have read the posts on Interfaces, etc.? \$\endgroup\$ – ComputerVersteher Feb 6 at 9:36
  • \$\begingroup\$ As no reviews (but votes, so basics match) till now, you can visit the rubberduck war room on chat (just search for rd) and leave a link. That may cause one of the knowing ones to notice your qoestion and review (my knowledge is not sufficent at now, as I am just reading through the blog and try to understand, when to use an interface) \$\endgroup\$ – ComputerVersteher Feb 6 at 10:07
3
\$\begingroup\$

The UserForm implemented here is specifically designed to demonstrate the CFrameSorter class functions. In doing so, the UI fulfills two roles: The CFrameSorter command initiator, and results viewer. In the actual system where the CFrameSorter is used, the CFrameSorter would most likely be commanded to Move and Hide Frames by a component other than the UI. That is a communication sequence something like:

Application object(s)issue Frame manipulation commands ==> CFrameSorter(issues frame position and visibility commands) ==> FrameDisplayUI (View) places and shows Frames in response to CFrameSorter input.

In the above sequence, the UI does not issue commands going right to left. The UI in this post (because it is a CFrameSorter tester/demonstrator) is playing the roles of both the Application and View. To prepare the CFrameSorter for use in your final system, making the visual test tool (the UserForm) better simulate the interactions described above is the theme for the following review.

The primary comment is this: The UI in the final design should be completely unaware of the concrete object(s) that are manipulating it. This is also the goal of the TestUI. Currently, when the UserForm is first created, UserForm_Initialize is called. The first thing it does is:

Set FrameSorter = New CFrameSorter
FrameSorter.Initialise Me

If these two commands were described in terms of human relationships, it would be the same as the UserForm telling the CFrameSorter, "I know who you are and everything about you. You are more than a member variable to me. You...complete me". In this scenario, interfaces is probaby the best way for the CFrameSorter to break out of this relationship "and still be friends".

We want to remove any awareness of the CFrameSorter class from the View..and, unltimately, any awareness of the View, from the CFrameSorter. "FrameSorter.Initialise Me" has to go. We want to do this for a few reasons, but the primary reason is that in the final system, the CFrameSorter will not be taking frame positioning commands from the UI. It will be issued commands from one or more application objects. The simplest way to set this up here is to create a StandardModule (FrameSorterTester). It's job is to simulate the Application. It will create a CFrameSorter instance as well as the View instance. Add an entry point to initiate the testing.

Sub TestCFrameSorter()
    Dim frameSorter As CFrameSorter
    Set frameSorter = New CFrameSorter

    Dim testView As TestFrameSorterView
    Set testView = New TestFrameSorterView

    Load testView
    testView.Show
End Sub

So, how to wire up the system if TestFrameSorterView is not to know anything about CFrameSorter class. Answer: Interfaces. Every VBA module that has Public subroutines, functions, or properties defines an interface. The interface is fundamentally a set of methods that define interactions. The implicit interface of CFrameSorter is:

    Public Property Get StartPosition() As Long
    End Property

    Public Property Let StartPosition(Value As Long)
    End Property

    Public Property Get Spacer() As Long
    End Property

    Public Property Let Spacer(Value As Long)
    End Property

    Public Property Get FrameDict() As Dictionary
    End Property

    Public Sub AddFrame(SourceFrame As Frame)
    End Sub

    Public Sub RemoveFrame(SourceFrame As Frame)
    End Sub

    Public Sub MoveUp(SourceFrame As Frame, Optional Position As Long = 1)
    End Sub

    Public Sub MoveDown(SourceFrame As Frame, Optional Position As Long = 1)
    End Sub

    Public Sub Move(SourceFrame As Frame, Position As Long)
    End Sub

    Public Sub Initialise(SourceForm As Object)
    End Sub

As you can see, all that I've done is copied Public methods from CFrameSorter and deleted everything else. Now, create a new ClassModule "IFrameSorter" with the above empty methods in it...you've just created an interface. When an object (any object) 'implements' the IFrameSorter interface, it MUST provide logic behind every method of the interface - even if it is to raise an error that says "Public Sub Move not implemented" (for example). To 'force' CFrameSorter to implement IFrameSorter you add "Implements IFrameSorter" at the top of the CFrameSorter class module. This defines a set of methods that CFrameSorter MUST implement (it already has the logic). A simple search on 'Implement an Interface in Excel VBA' will provide the rest of the details to get to the following version of CFrameSorter:

    Option Explicit

    Implements IFrameSorter


    Private FrameDictionary As Dictionary
    Private VisibleFrames As Dictionary
    Private pStartPosition As Long
    Private pSpacer As Long

    Private Sub Class_Initialize()
        Set FrameDictionary = New Dictionary
        Set VisibleFrames = New Dictionary
        pStartPosition = 6
        pSpacer = 10
    End Sub

    Private Property Let IFrameSorter_Spacer(RHS As Long)
        pSpacer = RHS
    End Property

    Private Property Get IFrameSorter_Spacer() As Long
        IFrameSorter_Spacer = pSpacer
    End Property

    Private Property Let IFrameSorter_StartPosition(RHS As Long)
        pStartPosition = RHS
    End Property

    Private Property Get IFrameSorter_StartPosition() As Long
        IFrameSorter_StartPosition = pStartPosition
    End Property

    Private Property Get IFrameSorter_FrameDict() As Scripting.IDictionary
        Set IFrameSorter_FrameDict = FrameDictionary
    End Property

    Private Sub IFrameSorter_AddFrame(SourceFrame As MSForms.IOptionFrame)
        If Not SourceFrame Is Nothing Then
            If FrameDictionary.Exists(SourceFrame.Name) Then
                With SourceFrame
                    If Not VisibleFrames.Exists(.Name) Then
                        .Visible = True
                        VisibleFrames.Add .Name, SourceFrame
                        ArrangeFrames
                    End If
                End With
            End If
        End If
    End Sub

    Private Sub IFrameSorter_RemoveFrame(SourceFrame As MSForms.IOptionFrame)
        If Not SourceFrame Is Nothing Then
            With SourceFrame
                If VisibleFrames.Exists(.Name) Then
                    .Visible = False
                    VisibleFrames.Remove (.Name)
                    ArrangeFrames
                End If
            End With
        End If
    End Sub

    Private Sub IFrameSorter_MoveUp(SourceFrame As MSForms.IOptionFrame, Optional Position As Long = 1&)
        Dim lPosition As Long
        lPosition = GetPositionInDict(SourceFrame)
        If lPosition > 1 Then
            MoveFrame SourceFrame, lPosition - 1
            ArrangeFrames
        End If
    End Sub

    Private Sub IFrameSorter_Move(SourceFrame As MSForms.IOptionFrame, Position As Long)
        MoveFrame SourceFrame, Position
        ArrangeFrames
    End Sub

    Private Sub IFrameSorter_MoveDown(SourceFrame As MSForms.IOptionFrame, Optional Position As Long = 1&)
        Dim lPosition As Long
        lPosition = GetPositionInDict(SourceFrame)
        If lPosition > 0 And lPosition < VisibleFrames.Count Then
            MoveFrame SourceFrame, lPosition + 1
            ArrangeFrames
        End If
    End Sub

    Private Sub IFrameSorter_Initialise(SourceForm As Object)
        Dim ctrl As Control
        Dim tmpSubSorter As CFrameSorter
        Dim vSortArray As Variant
        For Each ctrl In SourceForm.Controls
            If TypeName(ctrl) = "Frame" Then
                Select Case TypeName(ctrl.Parent)
                    Case TypeName(SourceForm)
                        With FrameDictionary
                            If Not .Exists(ctrl.Name) Then
                                .Add ctrl.Name, ctrl
                            End If
                        End With
                    Case "Frame"
                        'Do nothing yet.
                End Select
            End If
        Next ctrl
        'Sort the frames contained in the dictionary into
        'order based on their Top property.
        vSortArray = FrameDictToArray(FrameDictionary)
        Sort2DArray vSortArray
        SortDictByArray vSortArray, FrameDictionary
        'Create a dictionary of visible frames and then
        'arrange them on the form in order.
        GetVisibleFrames
        ArrangeFrames
    End Sub

    Private Function GetPositionInDict(SourceFrame As Frame) As Long
        Dim vItem As Variant
        Dim x As Long
        If Not SourceFrame Is Nothing Then
            If VisibleFrames.Exists(SourceFrame.Name) Then
                For Each vItem In VisibleFrames.Items
                    x = x + 1
                    If SourceFrame.Name = vItem.Name Then
                        GetPositionInDict = x
                        Exit For
                    End If
                Next vItem
            Else
                GetPositionInDict = -1
            End If
        End If
    End Function

    Private Sub GetVisibleFrames()
        Dim tmpDict As Dictionary
        Dim vItem As Variant
        If Not FrameDictionary Is Nothing Then
            If FrameDictionary.Count > 0 Then
                Set tmpDict = New Dictionary
                For Each vItem In FrameDictionary.Items
                    If vItem.Visible Then
                        tmpDict.Add vItem.Name, vItem
                    End If
                Next vItem
            End If
        End If
        Set VisibleFrames = tmpDict
    End Sub

    Private Sub MoveFrame(SourceFrame As Frame, Position As Long)
        Dim tmpDict As Dictionary
        Dim vItem As Variant
        Dim x As Long
        If Not SourceFrame Is Nothing Then
            Set tmpDict = New Dictionary
            SourceFrame.Visible = True
            If Not VisibleFrames.Exists(SourceFrame.Name) Then
                VisibleFrames.Add SourceFrame.Name, SourceFrame
            End If
            If Position > VisibleFrames.Count Then
                Position = VisibleFrames.Count
            ElseIf Position < 0 Then
                Position = 0
            End If
            If Position = VisibleFrames.Count Then
                VisibleFrames.Remove SourceFrame.Name
                VisibleFrames.Add SourceFrame.Name, SourceFrame
            Else
                VisibleFrames.Remove SourceFrame.Name
                For x = 0 To VisibleFrames.Count - 1
                    If x = Position - 1 Then
                        tmpDict.Add SourceFrame.Name, SourceFrame
                    End If
                    tmpDict.Add VisibleFrames.Items(x).Name, VisibleFrames.Items(x)
                Next x
                Set VisibleFrames = tmpDict
            End If
        End If
    End Sub

    Private Sub ArrangeFrames()
        Dim vItem As Variant
        Dim lTopRow As Long
        If Not VisibleFrames Is Nothing Then
            If VisibleFrames.Count > 0 Then
                lTopRow = pStartPosition
                For Each vItem In VisibleFrames.Items
                    vItem.Top = lTopRow
                    lTopRow = lTopRow + vItem.Height + pSpacer
                Next vItem
            End If
        End If
    End Sub

    Private Sub SortDictByArray(vSortArray As Variant, TargetDict As Dictionary)
        Dim tmpDict As Dictionary
        Dim vItem As Variant
        Dim x As Long
        If Not TargetDict Is Nothing Then
            If UBound(vSortArray) = TargetDict.Count - 1 Then
                Set tmpDict = New Dictionary
                For x = LBound(vSortArray) To UBound(vSortArray)
                    tmpDict.Add vSortArray(x, 1), TargetDict.Item(vSortArray(x, 1))
                Next x
                Set TargetDict = tmpDict
            End If
        End If
    End Sub

    Private Function FrameDictToArray(SourceDict As Dictionary) As Variant
        Dim tmpDict As Dictionary
        Dim x As Long
        Dim tmpArr As Variant
        Dim itm As Variant
        If Not SourceDict Is Nothing Then
            If SourceDict.Count > 0 Then
                Set tmpDict = New Dictionary
                ReDim tmpArr(0 To SourceDict.Count - 1, 0 To 1)
                For Each itm In SourceDict.Items
                    tmpArr(x, 0) = itm.Top
                    tmpArr(x, 1) = itm.Name
                    x = x + 1
                Next itm
                FrameDictToArray = tmpArr
            End If
        End If
    End Function

    Private Sub Sort2DArray(vArray As Variant, _
        Optional ByVal lLowStart As Long = -1, _
        Optional ByVal lHighStart As Long = -1)

        Dim vPivot As Variant
        Dim lLow As Long
        Dim lHigh As Long

        lLowStart = IIf(lLowStart = -1, LBound(vArray), lLowStart)
        lHighStart = IIf(lHighStart = -1, UBound(vArray), lHighStart)
        lLow = lLowStart
        lHigh = lHighStart

        vPivot = vArray((lLowStart + lHighStart) \ 2, 0)
        While lLow <= lHigh
            While (vArray(lLow, 0) < vPivot And lLow < lHighStart)
                lLow = lLow + 1
            Wend

            While (vPivot < vArray(lHigh, 0) And lHigh > lLowStart)
                lHigh = lHigh - 1
            Wend

            If (lLow <= lHigh) Then
                Swap vArray, lLow, lHigh
                lLow = lLow + 1
                lHigh = lHigh - 1
            End If
        Wend

        If (lLowStart < lHigh) Then
            Sort2DArray vArray, lLowStart, lHigh
        End If
        If (lLow < lHighStart) Then
            Sort2DArray vArray, lLow, lHighStart
        End If

    End Sub

    Private Sub Swap(vArray As Variant, lItem1 As Long, lItem2 As Long)
        Dim vTemp0 As Variant
        Dim vTemp1 As Variant
        vTemp0 = vArray(lItem1, 0)
        vTemp1 = vArray(lItem1, 1)
        vArray(lItem1, 0) = vArray(lItem2, 0)
        vArray(lItem1, 1) = vArray(lItem2, 1)
        vArray(lItem2, 0) = vTemp0
        vArray(lItem2, 1) = vTemp1
    End Sub

In order for the View to work with the interface, we will modify it as follows: (old code commented out)

    'Private FrameSorter As CFrameSorter
    Private frameSorter As IFrameSorter

    Private Sub UserForm_Initialize()
        'Dim vItem As Variant

        'Set FrameSorter = New CFrameSorter
        'FrameSorter.Initialise Me

        'Populate the combobox.
        'For Each vItem In frameSorter.FrameDict.Items
        '    Me.cmbFrames.AddItem vItem.Name
        'Next vItem

    End Sub

    Public Sub ApplyFrameSorter(sorter As IFrameSorter)
        Set frameSorter = sorter
        frameSorter.Initialise Me

        'Populate the combobox.
        Dim vItem As Variant
        For Each vItem In frameSorter.FrameDict.Items
            Me.cmbFrames.AddItem vItem.Name
        Next vItem
    End Sub

And the FrameSorterTester module as follows:

    Sub TestCFrameSorter()
        Dim frameSorter As IFrameSorter '<=== declare the interface
        Set frameSorter = New CFrameSorter '<== create the implementing object

        Dim testView As TestFrameSorterView
        Set testView = New TestFrameSorterView

        Load testView

        testView.ApplyFrameSorter frameSorter


        testView.Show
    End Sub

Initiating macro TestCFrameSorter will run your code and UI just as it did before.

Although functionally equivalent, an important change has just occurred. The View no longer creates CFrameSorter. All that the View knows is that there is now a set of methods (the IFrameSorter interface) that it has access to. Now the relationship can be described as: (View to IFrameSorter): "I don't know who you are, but you are more than an interface someone gave me. You...complete me"

Now, it is time to get rid of "Initialise Me" because is passes a UI element (itself) as the parameter. So, the task becomes: how to replace the functionality of Initialise without passing a reference to the View in the IFrameSorter interface methods.

The Initialise subroutine basically looks at all the Frame controls on the View and loads its Dictionaries. CFrameSorter does not need the UserForm to do this - it only needs a collection of Frame objects. So, let the View provide a collection of Frame objects by adding a public property (read-only) Frames.

    Public Property Get Frames() As Collection
        Dim myFrames As Collection
        Set myFrames = New Collection

        Dim ctrl As Control
        For Each ctrl In Me.Controls
            If TypeName(ctrl) = "Frame" Then
                Select Case TypeName(ctrl.Parent)
                    Case TypeName(Me)
                        myFrames.Add ctrl
                    Case "Frame"
                        'Do nothing yet.
                End Select
            End If
        Next ctrl
        Set Frames = myFrames
    End Property

And replace/comment out Initialise on the IFrameSorter interface with a new method - "LoadDictionaries":

    'Remove Initialise from the interface and add LoadDictionaries
    'Public Sub Initialise(SourceForm As Object)
    'End Sub

    Public Sub LoadDictionaries(vFrames As Collection)
    End Sub

Removing Initialise from the IFrameSorter means that it can no longer be called from the View. Method ApplyFrameSorter is the current user of Initialise.

In addition to setting the IFrameSorter variable, ApplyFrameSorter also loads the ComboBox items. So, a better name might have been "ApplyFrameSorterAndLoadComboBoxItems". But, that 'better' name betrays the fact that the method is doing two things. The Single Responsibility Principle (SRP) encourages us to always write methods that 'do one thing' - and the 'one thing' should be identified by the method's name. So, in the spirit of SRP...Let's add a public Property FrameSorterInterface to the View in order to set/get the IFrameSorter interface - one thing. And load the ComboBox (the second 'thing') some other way (Note: if we load the ComboBox as part of setting the property FrameSorterInterface, it would be considered an unadvertised side-effect of calling the property - always a good idea to avoid this).

Loading the ComboBox items: The ComboBox can be loaded by the the View. There is no need to use the IFrameSorter interface to help do this. From the moment it is created, the View knows everything it needs (names of all the 'Frame' controls) in order to load the ComboBox. So, the code that loads the ComboBox items can be moved back into UserForm_Initialize.

So now, property FrameSorterInterface and subroutine UserForm_Initialize are each doing one thing related to their names, and together, have replaced the functionality lost by removing Initialise from the IFrameSorter interface. The View code now looks like this:

    'TestFrameSorterView (UserForm) after removing "Initialise" from
    ' the IFrameSorter interface and adding property FrameSorterInterface

    Private Sub UserForm_Initialize()
        'Populate the combobox.
        Dim vItem As Variant
        For Each vItem In Frames 'frameSorter.FrameDict.Items
            Me.cmbFrames.AddItem vItem.Name
        Next vItem
    End Sub

    Public Property Set FrameSorterInterface(sorter As IFrameSorter)
        Set frameSorter = sorter
    End Property

    Public Property Get FrameSorterInterface() As IFrameSorter
        Set FrameSorterInterface = frameSorter
    End Property

Now let the FrameSorterTester be responsible for managing the initialization transactions between the CFrameSorter and the TestFrameSorterView. The macro now looks like this:

    Sub TestCFrameSorter()
        Dim frameSorter As IFrameSorter
        Set frameSorter = New CFrameSorter

        Dim testView As TestFrameSorterView
        Set testView = New TestFrameSorterView

        Load testView

        'Provide the View with the IFrameSorterInterface
        Set testView.FrameSorterInterface = frameSorter

        'Retrieve the Frame objects from the view and provide
        'them to CFrameSorter so that it can load its dictionaries
        Dim vFrames As Collection
        Set vFrames = testView.Frames       
        frameSorter.LoadDictionaries vFrames

        testView.Show
    End Sub

Again, after all that, from a functional perspective, nothing has changed. However, any awareness of the CFrameSorter class has been extracted from the View. It only knows that it can call the IFrameSorter interface and expect the right behavior. Further, CFrameSorter no longer knows about the TestFrameSorterView - it is handed a collection of Frame controls 'from somewhere' and initializes itself. So now (View to IFrameSorter): "I don't know who you are, you are only an interface someone gave me. So, don't call me, I'll call you if (and only if) I want something". The CFrameSorter now operates in a vacuum: "I don't know where these Frame control references are coming from, but I'll do what I'm asked to do".

There is still more that can be done. The IFrameSorter interface accepts Frame control references in the method signatures. This means, that if you ever want any object to implement the IFrameSorter interface, it needs to be connected to a UI that will provide actual controls. This implies that there is no opportunity to test CFrameSorter without using an actual UI. A better version of the IFrameSorter interface eliminates UI control references.

Removing the UI controls from the interface makes IFrameSorter independent of UI elements. Writing test code without an actual UI is now possible - and preferred. So, how to move the Frames without passing a Frame control reference?...again - an interface, but this interface is on the View. Let's call this new interface IFrameSorterView.

So, the IFrameSorter will look something like:

    Public Sub ShowFrame(frameName As String, IFrameSorterView view)
    End Sub

    Public Sub HideFrame(frameName As String, IFrameSorterView view)
    End Sub

    Public Sub MoveUp(frameName As String, IFrameSorterView view, Optional Position As Long = 1)
    End Sub

    Public Sub MoveDown(frameName As String, IFrameSorterView view, Optional Position As Long = 1)
    End Sub

    Public Sub Move(frameName As String, IFrameSorterView view, Position As Long)
    End Sub

    Public Sub LoadDictionaries(frameNames As Collection)
    End Sub

And IFrameSorterView can be something like:

    Public Sub ModifyFramePosition(frameName As String, topValue As Long)
    End Sub

    Public Sub ModifyFrameVisibility(frameName As String, isVisible As Boolean)
    End Sub

There are a lot of details to sort out to implement these two interfaces. But the goal is to extract UI and UI controls awareness from CFrameSorter.

Regarding the CFrameSorter code, there are a couple of Dictionaries that are storing position and visibility information. This replicates what is already stored and available from the View. So, there is probably an opportunity to eliminate the Dictionaries from CFrameSorter if the IFrameSorterView interface also includes some properties like:

    Public Property Get Top(frameName As String) As Long
    End Property 

    Public Property Get Height(frameName As String) As Long
    End Property

    Public Property Get IsVisible(frameName As String) As Boolean
    End Property 

Or, collect them all at once...and let IFrameSorterView act as your dictionaries

   'Dictionary of Frame names to Top position values
    Public Property Get FrameNamesToTop() As Dictionary 
    End Property 

    'Dictionary of Frame names to Visible values
    Public Property Get FrameNamesToIsVisible() As Dictionary 
    End Property 

    'Dictionary of Frame names to Height values
     Public Property Get FrameNamesToHeight() As Dictionary
     End Property

Hope this was helpful. Good luck!

I am certain that you will find this useful for your task.

| improve this answer | |
\$\endgroup\$
  • \$\begingroup\$ Thanks for your feedback. On first read it looks like you're explaining what I've been trying to get my head around for a while now. I'll have a better read through when I haven't got half a bottle of Jack inside me & get back to you. :) \$\endgroup\$ – Darren Bartrup-Cook Feb 29 at 22:25
  • \$\begingroup\$ Trying to work through this and have understood up to the point where you state "Initialise is gone from the interface, but the ComboBox was being loaded using the CFrameSorter. Let the View do this - it knows what Frames it has. Now ApplyFrameSorter can become a Property" - the code block below this is adding values to the combobox, although earlier in the answer you'd commented this out and moved it to the ApplyFrameSorter procedure. Should it still be commented out, or be in the ApplyFrameSorter? Feels like I was understanding it perfectly until I reached that point. :) \$\endgroup\$ – Darren Bartrup-Cook Mar 2 at 10:58
  • \$\begingroup\$ I've expanded the comments/explanations in that area. Hopefully it becomes more clear. And, to your specific question - I moved combo box loading out of UserForm_Initialize and then back in to UserForm_Initialize as part of the step-by-step refactoring process that kept the code functioning after each set of modifications. \$\endgroup\$ – BZngr Mar 2 at 15:40
  • \$\begingroup\$ Have been working through your examples. It's slowly starting to click although I've still got a way to go. Again, thankyou for your feedback. It's definitely helped in taking my code to the next level. \$\endgroup\$ – Darren Bartrup-Cook Mar 12 at 9:22

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.