3
\$\begingroup\$

I am working as a validation technician for excel spreadsheets in a pharma company. Sadly & interestingly I don't know much about VBA and Excel.

To validate those excel spreadsheet, I developped with macro-recording the following code, which helps me identifying the cell properties.

The goal is to quickly obtain relevant parameters by entering minimum of informations (password; analysis range)

Here is an example of what I am currently achieving :

Spreadsheet before analysis

Running the macro

Spreadsheet after anaylysis

Question :

  • how can I improve this code so it runs faster

  • If anybody worked with this kind of macro : any suggestions for further developments are welcome

Here are some ideas I cannot implement yet due to lack of knowledge

Ideas for further improvement :

  • Currently code overwrites worksheet name because I dont know how to extract sheet name

  • Ideally, it would be better to copy the worksheet then add the custom formula on the second sheet, so the original worksheet isn't changed

  • Insert input box to define worksheet and workbook password (these two have the same password)

  • Wish I could retrieve even more informations but I dont know how (such as existing data-validation requirements etc etc)

Sorry for your eyes, dear developpers, I am aware its really messy code but I didnt find a way to clear it efficiently, and it's currently working fine but rather slowly with old computer

Many thanks for your help,

Max

Option Explicit

Public Const MDP As String = "PASSWORD"


----------


Sub Cell_analysis()

'Unprotect
    ActiveSheet.Unprotect Password:=MDP
    ActiveWorkbook.Unprotect Password:=MDP

'Define range with input box
    Dim rng As Range
    Dim DefaultRange As Range
    Dim FormatRuleInput As String
    ActiveSheet.Name = "Sheet1"

  If TypeName(Selection) = "Range" Then
    Set DefaultRange = Selection
  Else
    Set DefaultRange = ActiveCell
  End If

  On Error Resume Next
    Set rng = Application.InputBox( _
      Title:="Select Worksheet Range", _
      Prompt:="Select Worksheet Range", _
      Default:=DefaultRange.Address, _
      Type:=8)

  On Error GoTo 0
  If rng Is Nothing Then Exit Sub

'Unmerge all cells
    rng.UnMerge

'Use following formula to retrieve cell informations
    ActiveSheet.Copy After:=Sheets(1)
    rng.Cells.FormulaR1C1 = "=CELL(""Format"",'Sheet1 (2)'!RC)&"" , ""&CELL(""Protect"",'Sheet1 (2)'!RC)&""     ,     ""&ISFORMULA('Sheet1 (2)'!RC)"

'Conditional formatting
    Dim condition1, condition2, condition3, condition4, condition5, condition6, condition7, condition8, condition9, condition10, condition11, condition12, condition13, condition14, condition15, condition16, condition17, condition18, condition19, condition20, condition21, condition22, condition23, condition24, condition25, condition26 As FormatCondition

'Clear existing formatting
    rng.FormatConditions.Delete

'List conditions
    Set condition1 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="G , 0")
    Set condition2 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="D1 , 0")
    Set condition3 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="D2 , 0")
    Set condition4 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F0 , 0")
    Set condition5 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F1 , 0")
    Set condition6 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F2 , 0")
    Set condition7 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F3 , 0")
    Set condition8 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F4 , 0")
    Set condition9 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F5 , 0")
    Set condition10 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F6 , 0")
    Set condition11 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F7 , 0")
    Set condition12 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F8 , 0")
    Set condition13 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F9 , 0")
    Set condition14 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="G , 1")
    Set condition15 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="D1 , 1")
    Set condition16 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="D2 , 1")
    Set condition17 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F0 , 1")
    Set condition18 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F1 , 1")
    Set condition19 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F2 , 1")
    Set condition20 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F3 , 1")
    Set condition21 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F4 , 1")
    Set condition22 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F5 , 1")
    Set condition23 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F6 , 1")
    Set condition24 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F7 , 1")
    Set condition25 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F8 , 1")
    Set condition26 = rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="F9 , 1")

'conditional formatting options
   With condition1
   .Interior.Color = RGB(255, 255, 255)
    .Font.ColorIndex = 3
   End With

    With condition2
    .Interior.Color = RGB(153, 204, 255)
.Font.ColorIndex = 3
   End With

   With condition3
   .Interior.Color = RGB(102, 178, 255)
.Font.ColorIndex = 3
   End With

   With condition4
   .Interior.Color = RGB(229, 255, 204)
.Font.ColorIndex = 3
   End With

   With condition5
   .Interior.Color = RGB(204, 255, 153)
 .Font.ColorIndex = 3
   End With

   With condition6
   .Interior.Color = RGB(178, 255, 102)
.Font.ColorIndex = 3
   End With

   With condition7
   .Interior.Color = RGB(153, 255, 51)
  .Font.ColorIndex = 3
   End With

    With condition8
    .Interior.Color = RGB(128, 218, 0)
 .Font.ColorIndex = 3
   End With

     With condition9
     .Interior.Color = RGB(102, 204, 0)
 .Font.ColorIndex = 3
   End With

   With condition10
   .Interior.Color = RGB(76, 153, 0)
.Font.ColorIndex = 3
   End With

    With condition11
    .Interior.Color = RGB(51, 102, 0)
.Font.ColorIndex = 3
   End With

   With condition12
   .Interior.Color = RGB(37, 72, 0)
.Font.ColorIndex = 3
   End With

    With condition13
    .Interior.Color = RGB(25, 45, 0)
.Font.ColorIndex = 3
   End With



  With condition14.Interior
    .Color = RGB(255, 255, 255)

   End With

    With condition15.Interior
    .Color = RGB(153, 204, 255)

   End With

   With condition16.Interior
    .Color = RGB(102, 178, 255)

   End With

   With condition17.Interior
    .Color = RGB(229, 255, 204)

   End With

   With condition18.Interior
    .Color = RGB(204, 255, 153)

   End With

   With condition19.Interior
    .Color = RGB(178, 255, 102)

   End With

   With condition20.Interior
    .Color = RGB(153, 255, 51)

   End With

    With condition21.Interior
    .Color = RGB(128, 218, 0)

   End With

     With condition22.Interior
     .Color = RGB(102, 204, 0)

   End With

   With condition23.Interior
    .Color = RGB(76, 153, 0)

   End With

    With condition24.Interior
     .Color = RGB(51, 102, 0)

   End With

   With condition25.Interior
    .Color = RGB(37, 72, 0)

   End With

    With condition26.Interior
    .Color = RGB(25, 45, 0)

   End With

'Select the sheet to see the final result

    Worksheets("Sheet1").Activate

'Result shaping
    rng.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .ColumnWidth = 15
        .RowHeight = 18
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Name = "Calibri"
        .Font.Bold = True
        .Font.Size = 11
        .Font.Underline = False
        .Font.Italic = False

    End With

'Display result of analyzed cells
    MsgBox rng.Count & "   Cells treated : " & rng.Columns.Count & " Columns" & " & " & rng.Rows.Count & "  Rows"


End Sub
\$\endgroup\$
2
  • 2
    \$\begingroup\$ The Macro Recorder Curse can be cured (read other post too)! RubberduckVBA will provide useful hints to improve code. \$\endgroup\$ Feb 12, 2020 at 23:52
  • \$\begingroup\$ Data belongs to databases and should be validated there. Have look at Object-Browser inVBA-IDE(on view tab) to get all members of a type (e.g Range). \$\endgroup\$ Feb 13, 2020 at 0:01

2 Answers 2

4
\$\begingroup\$

Having Option Explicit is a great start :+1: for that alone!


Your Const MDP doesn't need to be declared outside your Sub. In fact it should be a local variable to that Sub as it's only used there. You unprotect the ActiveSheet & ActiveWorkbook but never reprotect that. Feels like a possible oversight.


Explicitly declare your Sub statements with Public or Private. If you don't declare this it is implicitly Public. Make your intent clear by including it.


Comments. I did the same thing when I first started with VBA. Code should be self documenting. Write code in such a way that it is self evident what is occurring. Then if need you to explain why something is done a specific way a comment is appropriate. Otherwise the comment is noise. 'Unmerge all cells is self evident with rangeVariable.UnMerge the comment is restating what was already stated.

If you have a comment that's explaining what is being done, like a comment banner, then that is an indicator you should break that logical group of code into its own Sub/Function (aka Member). This increases the abstraction layer and makes the code more self documenting.


Declare your variables just before using them. This lets you realize that Dim FormatRuleInput As String is never referenced anywhere and should be deleted.

Use descriptive variable names. rng doesn't help specify what it is whereas formatConditionsArea tells me you're working with FormatConditions.

Declare variables on their own individual line. Dim condition1, ... , condition26 As FormatCondition has only the last variable condition26 as a FormatCondition. You can see this behavior by displaying the Locals window from the menu at the top Edit>Locals Window then step into/through the code with F8.

To remedy this eliminate them all together. You can use a With statement to hold the variable reference while you assign the properties. Removes the need for the variable altogether.

With rng.FormatConditions.Add(xlTextString, TextOperator:=xlContains, String:="G , 0")
    .Interior.Color = RGB(255, 255, 255)
    .Font.ColorIndex = 3
End With

Then notice that you're doing the same thing again and again. Extract this into a dedicated sub with parameters. The refactored Sub below includes the use of the Optional keyword. The first 3 parameters are required and the last is optional (self documenting code example right here). The use of the IsMissing function mandates that fontColorIndex type is a Variant.

Private Sub ApplyConditionalFormattingTo(ByVal formatArea As Range, _
                                            ByVal checkForValue As String, _
                                            ByVal interiorColor As Long, _
                                            Optional ByVal fontColorIndex As Variant)
    With formatArea.FormatConditions.Add(XlFormatConditionType.xlTextString, TextOperator:=XlContainsOperator.xlContains, String:=checkForValue)
        .Interior.Color = interiorColor

        If Not IsMissing(FontColorIndex) Then
            .Font.ColorIndex = FontColorIndex
        End If
    End With
End Sub

Then supply arguments to those parameters. This cleans up the code a lot. A Const statement is used so that if the need arises you change it once and all uses of it update.

Const FontColorIndex As Long = 3
ApplyConditionalFormattingTo rng, "G , 0", RGB(255, 255, 255), FontColorIndex
...
ApplyConditionalFormattingTo rng, "F9 , 1", RGB(25, 45, 0)

Create a variable to store the sheet you want to work on. Then work off that variable.

Dim formatSheet As Worksheet
Set formatSheet = ActiveSheet
Dim formatRuleInput As String
formatSheet.Name = "Sheet1"

Later after you copy the sheet you can activate the sheet you were formatting with formatSheet.Activate. Are you making a copy of the worksheet in case something messes up? If so, explicitly mark the copied sheet as such. If not then this copy just feels out of place.

You want to avoid using someVariable.Select followed by Selection.AnyMember as it's almost never required. This occurred because you used the macro recorder. Replace

Worksheets("Sheet1").Activate
rng.Select
With Selection
    .HorizontalAlignment = xlCenter

with the code below. Directly connect them together as someVariable.AnyMember to eliminate this selecting.

formatSheet.Activate
With addConditionsArea
    .HorizontalAlignment = xlCenter

Within the with block there are a lot of properties that likely don't need to be there. The macro recorder does not generate efficient code and will usually include properties you don't actually want/need. Review each member in that with block and remove those you don't need.

A example of the macro recorders inefficiency is

.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous

which can be replaced with

.BorderAround XlLineStyle.xlContinuous

Putting everything together.

Option Explicit

Public Sub CellAnalysis()
    Const MDP As String = "PASSWORD"
    ActiveSheet.Unprotect Password:=MDP
    ActiveWorkbook.Unprotect Password:=MDP

    Dim formatSheet As Worksheet
    Set formatSheet = ActiveSheet
    Dim FormatRuleInput As String
    formatSheet.Name = "Sheet1"

    Dim defaultRange As Range
    If TypeName(Selection) = "Range" Then
        Set defaultRange = Selection
    Else
        Set defaultRange = ActiveCell
    End If

    On Error Resume Next
    Dim formatConditionsArea As Range
    Set formatConditionsArea = Application.InputBox( _
              Title:="Select Worksheet Range", _
              Prompt:="Select Worksheet Range", _
              Default:=defaultRange.Address, _
              Type:=8)

    On Error GoTo 0
    If formatConditionsArea Is Nothing Then Exit Sub

    formatConditionsArea.UnMerge

    'Use following formula to retrieve cell informations
    formatSheet.Copy After:=Sheets(1)
    formatConditionsArea.Cells.FormulaR1C1 = "=CELL(""Format"",'Sheet1 (2)'!RC)&"" , ""&CELL(""Protect"",'Sheet1 (2)'!RC)&""     ,     ""&ISFORMULA('Sheet1 (2)'!RC)"

    formatConditionsArea.FormatConditions.Delete

    Const fontColorIndex As Long = 3
    ApplyConditionalFormattingTo formatConditionsArea, "G , 0", RGB(255, 255, 255), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "D1 , 0", RGB(153, 204, 255), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "D2 , 0", RGB(102, 178, 255), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F0 , 0", RGB(229, 255, 204), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F1 , 0", RGB(204, 255, 153), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F2 , 0", RGB(178, 255, 102), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F3 , 0", RGB(153, 255, 51), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F4 , 0", RGB(128, 218, 0), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F5 , 0", RGB(102, 204, 0), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F6 , 0", RGB(76, 153, 0), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F7 , 0", RGB(51, 102, 0), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F8 , 0", RGB(37, 72, 0), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "F9 , 0", RGB(25, 45, 0), fontColorIndex
    ApplyConditionalFormattingTo formatConditionsArea, "G , 1", RGB(255, 255, 255)
    ApplyConditionalFormattingTo formatConditionsArea, "D1 , 1", RGB(153, 204, 255)
    ApplyConditionalFormattingTo formatConditionsArea, "D2 , 1", RGB(102, 178, 255)
    ApplyConditionalFormattingTo formatConditionsArea, "F0 , 1", RGB(229, 255, 204)
    ApplyConditionalFormattingTo formatConditionsArea, "F1 , 1", RGB(204, 255, 153)
    ApplyConditionalFormattingTo formatConditionsArea, "F2 , 1", RGB(178, 255, 102)
    ApplyConditionalFormattingTo formatConditionsArea, "F3 , 1", RGB(153, 255, 51)
    ApplyConditionalFormattingTo formatConditionsArea, "F4 , 1", RGB(128, 218, 0)
    ApplyConditionalFormattingTo formatConditionsArea, "F5 , 1", RGB(102, 204, 0)
    ApplyConditionalFormattingTo formatConditionsArea, "F6 , 1", RGB(76, 153, 0)
    ApplyConditionalFormattingTo formatConditionsArea, "F7 , 1", RGB(51, 102, 0)
    ApplyConditionalFormattingTo formatConditionsArea, "F8 , 1", RGB(37, 72, 0)
    ApplyConditionalFormattingTo formatConditionsArea, "F9 , 1", RGB(25, 45, 0)

    'Select the sheet to see the final result
    formatSheet.Activate
    With formatConditionsArea
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .ColumnWidth = 15
        .RowHeight = 18
        .BorderAround XlLineStyle.xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Bold = True
    End With

    'Display result of analyzed cells
    MsgBox formatConditionsArea.Count & "   Cells treated : " & formatConditionsArea.Columns.Count & " Columns" & " & " & formatConditionsArea.Rows.Count & "  Rows"
End Sub

Private Sub ApplyConditionalFormattingTo(ByVal formatArea As Range, _
                                            ByVal checkForValue As String, _
                                            ByVal interiorColor As Long, _
                                            Optional ByVal fontColorIndex As Variant)
    With formatArea.FormatConditions.Add(XlFormatConditionType.xlTextString, _
                                            TextOperator:=XlContainsOperator.xlContains, _
                                            String:=checkForValue)
        .Interior.Color = interiorColor

        If Not IsMissing(fontColorIndex) Then
            .Font.ColorIndex = fontColorIndex
        End If
    End With
End Sub
```
\$\endgroup\$
2
  • \$\begingroup\$ The 'Select the sheet to see the final result and formatSheet.Activate lines are a good example of a why comment. When I was reading through the write up, I my initial thought was "There's no need to formatSheet.Activate!" but the why comment let me know that there was a reason for it. \$\endgroup\$
    – FreeMan
    Feb 21, 2020 at 12:29
  • \$\begingroup\$ Hey, thank you for these detailed explanations ! Helped me a lot understanding what was going on \$\endgroup\$
    – Max
    Feb 24, 2020 at 0:22
2
\$\begingroup\$
  • To keep you DRY use loops and arrays.
  • Never (almost) use .Select, Selection. see the-macro-recorder-curse
  • Avoid implicit references (e.g Worksheets("Sheet1").Activate is ActiveWorkBook.Worksheets("Sheet1").Activate). Use explicit refs, best Sheets CodeName, as e.g Sheetnames can be edited and wrong codename raises error at compile not run-time as missing sheetname.
Sub Cell_analysis()
    Dim wb As Workbook
    Set wb = ThisWorkbook
'Unprotect
    wb.Unprotect Password:=MDP
    Sheet1.Unprotect Password:=MDP

'Define range with input box
    Dim rng As Range
    Dim DefaultRange As Range
    Dim FormatRuleInput As String
    Sheet1.Name = "Sheet1"

    If TypeName(Selection) = "Range" Then 'as you select sth it is valid to use Selection here
        Set DefaultRange = Selection
    Else
        Set DefaultRange = ActiveCell
    End If

  On Error Resume Next 'when using On Error Resume Next, always handle error or you propagate "ignorance is bliss!"
    Set rng = Application.InputBox( _
      Title:="Select Worksheet Range", _
      Prompt:="Select Worksheet Range", _
      Default:=DefaultRange.Address, _
      Type:=8)
    If Err.Number <> 0 Then
      'handle error
    End If
  On Error GoTo 0
    If rng Is Nothing Then Exit Sub

'Unmerge all cells
    With rng
        .UnMerge

'Use following formula to retrieve cell informations
        Dim NewSheet As Worksheet
        Sheet1.Copy After:=Sheet1
        Set NewSheet = ThisWorkbook.Worksheets(Sheet1.Index + 1)
        .Cells.FormulaR1C1 = "=CELL(""Format"",'" & NewSheet.Name & "'!RC) & CELL(""Protect"",'" & NewSheet.Name & "'!RC) & ISFORMULA('" & NewSheet.Name & "'!RC)"

    'Conditional formatting
        Dim ConditionArr(0 To 25) As FormatCondition ', condition2, condition3, condition4, condition5, condition6, condition7, condition8, condition9, condition10, condition11, condition12, condition13, condition14, condition15, condition16, condition17, condition18, condition19, condition20, condition21, condition22, condition23, condition24, condition25, condition26 As FormatCondition

    'Clear existing formatting
        With .FormatConditions
            .Delete
            Dim StringArr As Variant
            StringArr = Array("G , 0", "D1 , 0", "D2 , 0", "F0 , 0", "F1 , 0", "F2 , 0", "F3 , 0", "F4 , 0", "F5 , 0", "F6 , 0", "F7 , 0", "F8 , 0", "F9 , 0" _
                   , "G , 1", "D1 , 1", "D2 , 1", "F1 , 1", "F1 , 1", "F2 , 1", "F3 , 1", "F4 , 1", "F5 , 1", "F6 , 1", "F7 , 1", "F8 , 1", "F9 , 1")
    'List conditions
            Dim n As Long
            For n = 0 To UBound(ConditionArr) - 1
                Set ConditionArr(n) = .Add(xlTextString, TextOperator:=xlContains, String:=StringArr(n))
            Next n

            Dim ColorArr As Variant
    'conditional formatting options
            ColorArr = Array(RGB(255, 255, 255), RGB(153, 204, 255), RGB(102, 178, 255), RGB(229, 255, 204), RGB(204, 255, 153), RGB(178, 255, 102), RGB(153, 255, 51) _
                    , RGB(128, 218, 0), RGB(102, 204, 0), RGB(76, 153, 0), RGB(51, 102, 0), RGB(37, 72, 0), RGB(25, 45, 0) _
                    , RGB(255, 255, 255), RGB(153, 204, 255), RGB(102, 178, 255), RGB(229, 255, 204), RGB(204, 255, 153), RGB(178, 255, 102), RGB(153, 255, 51) _
                    , RGB(128, 218, 0), RGB(102, 204, 0), RGB(76, 153, 0), RGB(51, 102, 0), RGB(37, 72, 0), RGB(25, 45, 0))
            For n = 0 To UBound(ColorArr) - 1
                With ConditionArr(n)
                    .Interior.Color = ColorArr(n)
                    If n < 13 Then
                        .Font.ColorIndex = 3
                    End If
                End With
            Next n
        End With

'Select the sheet to see the final result

        Sheet1.Activate

    'Result shaping

        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .ColumnWidth = 15
        .RowHeight = 18
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Name = "Calibri"
        .Font.Bold = True
        .Font.Size = 11
        .Font.Underline = False
        .Font.Italic = False
    End With

'Display result of analyzed cells
    MsgBox rng.Count & "   Cells treated : " & rng.Columns.Count & " Columns" & " & " & rng.Rows.Count & "  Rows"

End Sub

Maybe not much faster, but far better readable, code shrunk to 40%

\$\endgroup\$
2
  • 1
    \$\begingroup\$ This use of arrays feels awkward and unwarranted. It also constrains mandates the order of the formatting because of the static number 13 for the element position. Truth be told though, I did this same before learning about parameterizing methods, as included in my answer. \$\endgroup\$
    – IvenBach
    Feb 20, 2020 at 22:38
  • \$\begingroup\$ @IvenBach I agree! Focused too much on not repeating, Extracting the formating to a method, is far less error prone and far easier to understand (what should be main goal when writing code).. \$\endgroup\$ Feb 20, 2020 at 23:32

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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