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:

enter image description here

---

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

• Mathieu Guindon: Well done! Dependency Injection (DI) would be e.g. treating the collection of IStyleInfoAction objects as a dependency, and providing them to the processor class via a Property Set member, a factory method, or as an argument to the Process method. That way adding new actions doesn't require modifying the processor class. If you inject all the dependencies of your class, you're able to write code that tests its functionality (and injects test-controlled dependencies) - unit tests.
• Mathieu Guindon: Actually the only DI techniques available to VBA are property injection and method injection; the normally preferred constructor injection is ruled out, for lack of constructors in the language ...but property injection via a factory method gets pretty close - see here and here =)
• Ricardo Diaz: @MathieuGuindon Thank you for all the insights. For DI is it good practice if I place a Private Sub InitializeStyleProcessor(ByVal processor As StyleProcessor) where I add the StyleActions and use processor.Create styleActions in the Macros module?
• Ricardo Diaz: My previous question was based on your post here
• TinMan: Another compelling reason to union the ranges before changing the Styles in in the case of Swapping Styles. Say for instance you wanted to change all the Accent1 to Accent 2 and all the Accent2 to Accent1. This will not be possible unless you create all the unions before you change the styles.

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.

• Ricardo Diaz: This is awesome and very illustrative feedback. Thank you! Could you elaborate more on this suggestion: "You should also test changing name of individual cells styles versus Union the range for large number of cells" ?
• TinMan: @RicardoDiaz Here is my answer to Brute force looping & formatting Or Create Union range & Format? Which is efficient and when?. The question does a good job of explaining the performances of formatting individual versus groups of cells.
• TinMan: @RicardoDiaz Another thing that I forgot to mention, you should add a Restore Default Styles button.
• Ricardo Diaz: Thank you. You 're right about the restore button. Checking the link right now.