Manage Excel Styles with VBA OOP Approach (Follow up)

Question

This is a follow up to this question

Code incorporates Mathieu's comments and it works. As some parts of the review left some code to my knowledge, I ask for another review to see if I implemented them correctly.

Objectives:

• Load the current Styles list (name and type=builtin or custom) in an Excel Structured Table (ListObject)

• Allow users to:

  1. Delete

  2. Duplicate (create a new style based on another)

  3. Replace (one style with another)

---

Main suggestions from previous review:

• Apply naming conventions

• Add factory method

• Add Actions by composition

---

Note: My current level couldn't understand well how to apply the dependency injection concept

---

GUI:

---

Module: Macros

'@Folder("Styles")
Option Explicit

Public Sub LoadStyles()

    Dim myStyleProcessor As StyleProcessor

    Set myStyleProcessor = New StyleProcessor

    myStyleProcessor.LoadToTable

End Sub

Public Sub ProcessStyles()

    Dim myStyleProcessor As StyleProcessor

    Set myStyleProcessor = New StyleProcessor

    myStyleProcessor.LoadFromTable
    myStyleProcessor.Process
    myStyleProcessor.LoadToTable

End Sub

---

Class: StyleInfo

'@Folder("Styles")
'@PredeclaredID
Option Explicit

Public Enum Action
    DeleteStyle
    DuplicateStyle
    ReeplaceStyle
    RenameStyle
End Enum

Private Type TStyleInfo
    Style As Style
    Name As String
    Action As String
    Target As String
    Exists As Boolean
End Type

Private this As TStyleInfo

Public Property Let Name(ByVal value As String)
    this.Name = value
End Property

Public Property Get Name() As String
    Name = this.Name
End Property

Public Property Let Action(ByVal value As String)
    this.Action = value
End Property

Public Property Get Action() As String
    Action = this.Action
End Property

Public Property Let Target(ByVal value As String)
    this.Target = value
End Property

Public Property Get Target() As String
    Target = this.Target
End Property

Public Property Set Style(ByVal Style As Style)
    Set this.Style = Style
End Property

Public Property Get Style() As Style
    Set Style = this.Style
End Property

Public Property Get Self() As StyleInfo
    Set Self = Me
End Property

Public Function Create(ByVal Name As String, ByVal Action As String, ByVal Target As String) As StyleInfo
    With New StyleInfo
        .Name = Name
        .Action = Action
        .Target = Target
        If Exists(Name) Then
           Set .Style = ThisWorkbook.Styles(Name)
        End If
        Set Create = .Self
    End With
End Function

Public Function Exists(ByVal Name As String) As Boolean
    ' Returns TRUE if the named style exists in the target workbook.
    On Error Resume Next
    Exists = Len(ThisWorkbook.Styles(Name).Name) > 0
    On Error GoTo 0

End Function

Class: StyleProcessor

'@Folder("Styles")
Option Explicit

Private infos As Collection
Private StyleActions As Collection

Private Sub Class_Initialize()
    Set infos = New Collection
    Set StyleActions = New Collection
    StyleActions.Add New StyleActionDelete, "Delete"
    StyleActions.Add New StyleActionDuplicate, "Duplicate"
    StyleActions.Add New StyleActionReplace, "Replace"
End Sub

Private Sub Class_Terminate()
    Set infos = Nothing
End Sub

'TODO Public Sub Add(obj As StyleInfo) : infos.Add obj : End Sub
'TODO Public Sub Remove(Index As Variant) : infos.Remove Index : End Sub

'@DefaultMember
Public Property Get Item(ByVal Index As Variant) As StyleInfo
    Set Item = infos.Item(Index)
End Property

Public Property Get Count() As Long
    Count = infos.Count
End Property


Public Sub LoadToTable()

    Dim stylesTable As ListObject
    Dim currentStyle As Style

    Dim tempStyleInfo() As Variant
    Dim counter As Long
    Dim counterStyles As Long

    counter = 0

    counterStyles = ThisWorkbook.Styles.Count
    ReDim tempStyleInfo(counterStyles + 1, 3)


    Set stylesTable = MStyles.ListObjects("TableStyles")

    If Not stylesTable.DataBodyRange Is Nothing Then stylesTable.DataBodyRange.Delete

    For Each currentStyle In ThisWorkbook.Styles

        tempStyleInfo(counter, 0) = currentStyle.Name
        tempStyleInfo(counter, 1) = IIf(currentStyle.BuiltIn, "BuiltIn", "Custom")
        counter = counter + 1

    Next currentStyle

    stylesTable.Resize stylesTable.Range.Resize(RowSize:=UBound(tempStyleInfo, 1))

    stylesTable.DataBodyRange = tempStyleInfo

End Sub

Public Sub LoadFromTable()

    Dim stylesTable As ListObject
    Dim styleCell As Range

    Set stylesTable = MStyles.ListObjects("TableStyles")

    For Each styleCell In stylesTable.DataBodyRange.Columns(1).Cells

        If styleCell.Offset(ColumnOffset:=2) <> vbNullString Then

            infos.Add StyleInfo.Create(styleCell.Value2, styleCell.Offset(ColumnOffset:=2).Value2, styleCell.Offset(ColumnOffset:=3).Value2)

        End If

    Next styleCell


End Sub

Public Sub Process()

    Dim info As StyleInfo
    For Each info In infos
        Dim strategy As IStyleInfoAction
        Set strategy = StyleActions(info.Action)
        strategy.Run info
    Next

End Sub

Class (Interface): IStyleInfoAction

'@Folder("Styles")
Option Explicit

Public Sub Run(ByVal newStyleInfo As StyleInfo)
End Sub

Class: StyleActionDelete

'@Folder("Styles.Action")
Option Explicit

Implements IStyleInfoAction

Private Sub IStyleInfoAction_Run(ByVal newStyleInfo As StyleInfo)
    If Not newStyleInfo.Style Is Nothing Then newStyleInfo.Style.Delete
End Sub

Class: StyleActionDuplicate

'@Folder("Styles.Action")
Option Explicit

Implements IStyleInfoAction

Private Sub IStyleInfoAction_Run(ByVal newStyleInfo As StyleInfo)
    Dim styleCell As Range
    Dim newName As String

    Set styleCell = MStyles.Range("E1")

    styleCell.Style = newStyleInfo.Name

    newName = newStyleInfo.Target

    ThisWorkbook.Styles.Add newName, styleCell

    styleCell.Clear

End Sub

Class: StyleActionReplace

'@Folder("Styles.Action")
Option Explicit

Implements IStyleInfoAction

Private Sub IStyleInfoAction_Run(ByVal newStyleInfo As StyleInfo)

    Dim evalCell As Range
    Dim newStyle As Style
    Dim replaceSheet As Worksheet

    Set newStyle = ThisWorkbook.Styles(newStyleInfo.Target)

    For Each replaceSheet In ThisWorkbook.Worksheets

        For Each evalCell In replaceSheet.UsedRange.Cells

            If evalCell.Style = newStyleInfo.Style And evalCell.MergeCells = False Then evalCell.Style = newStyle

        Next evalCell

    Next replaceSheet

End Sub

Link to current file

Answer 1

Over all the code is really good but LoadToTable() could be tweaked.

Public Sub LoadToTable()

1     Dim stylesTable As ListObject
2     Dim currentStyle As Style

3     Dim tempStyleInfo() As Variant
4     Dim counter As Long
5     Dim counterStyles As Long

6     counter = 0

7     counterStyles = ThisWorkbook.Styles.Count
8     ReDim tempStyleInfo(counterStyles + 1, 3)


9     Set stylesTable = MStyles.ListObjects("TableStyles")

10     If Not stylesTable.DataBodyRange Is Nothing Then stylesTable.DataBodyRange.Delete

11     For Each currentStyle In ThisWorkbook.Styles

12         tempStyleInfo(counter, 0) = currentStyle.name
13         tempStyleInfo(counter, 1) = IIf(currentStyle.BuiltIn, "BuiltIn", "Custom")
14         counter = counter + 1

15     Next currentStyle

16     stylesTable.Resize stylesTable.Range.Resize(RowSize:=UBound(tempStyleInfo, 1))

17     If stylesTable.DataBodyRange Is Nothing Then stylesTable.ListRows.Add

18     stylesTable.DataBodyRange = tempStyleInfo

   End Sub

Line 6 counter = 0

This is the first time counter is used there is no reason to initiate a variable to its default value.

Line 7 counterStyles = ThisWorkbook.Styles.Count

counterStyles does little to add to the readability of the code. It's clear what ThisWorkbook.Styles.Count does counterStyles is just adding 2 extra lines to the subroutines body.

Line 8 ReDim tempStyleInfo(counterStyles + 1, 3) counterStyles + 1 is wrong. It causing tempStyleInfo to be created with 2 extra rows.

I prefer to work with 1 based arrays when writing data to a range. Using

 ReDim tempStyleInfo(1 to counterStyles, 1 to 4)

Here is the correct declaration for the 0 based array:

 ReDim tempStyleInfo(0 to counterStyles - 1, 0 to 3)

Although not necessary it is recommended to include the array base size when declaring an array.

Line 9 Set stylesTable = MStyles.ListObjects("TableStyles")

Consider passing in thestylesTable as a parameter of the Create method.

9     Set stylesTable = MStyles.ListObjects("TableStyles")
10     If Not stylesTable.DataBodyRange Is Nothing Then 

Lines 9 and 10 should appear after the Line 15. There is no reason to modify the table before the data is compiled. As a rule, I gather the data in a separate sub or function. This allows me to test the two tasks independently.

Line 16 stylesTable.Resize stylesTable.Range.Resize(RowSize:=UBound(tempStyleInfo, 1))

Line 17 If stylesTable.DataBodyRange Is Nothing Then stylesTable.ListRows.Add

Line 17 never triggers because Line 16 already added the correct number of rows.

Line 11 For Each currentStyle In ThisWorkbook.Styles

Using ThisWorkbook severely limits the usefulness of the code. It would be far better to set the target workbook in the Create method. Other classes are also limited by ThisWorkbook. I would set a reference to the parent StyleProcessor class in these class's Create methods so you can reference the parent's target workbook (e.g. Parent.TargetWorkbook).

Refactored Code

Public Sub LoadToTable()
    Dim Values
    Values = getStyleInfo()

    If Not stylesTable.DataBodyRange Is Nothing Then stylesTable.DataBodyRange.Delete
    stylesTable.ListRows.Add
    stylesTable.DataBodyRange.Resize(UBound(Values, 1)) = Values

End Sub

Private Function getStyleInfo()
    Dim Results
    ReDim Results(1 To TargetWorkbook.Styles.Count, 1 To stylesTable.ListColumns.Count)

    Dim n As Long
    Dim currentStyle As Style
    For Each currentStyle In TargetWorkbook.Styles
        n = n + 1
        Results(n, 1) = currentStyle.name
        Results(n, 2) = IIf(currentStyle.BuiltIn, "BuiltIn", "Custom")
     Next

     getStyleInfo = Results
End Function

Application.ScreenUpdating should be turned off when updating styles. You should also test changing name of individual cells styles versus Union the range for large number of cells.