Code simplification (format and conditional formatting)

Hey all,

I finished my code on how to format my worksheet.

For the sake of efficiency and speed, is there a way to improve my code?
This is only a snippet of my bigger project...

Sub apply_all_formatting()

' Freeze panes
' ------------

ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True

' Formatting
' ----------
  
Set wsSheet1 = Sheets("Sheet1")

    With wsSheet1
    
    ' Create a Table with no TableStyle

     .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = "Summary"
     .ListObjects("Summary").TableStyle = ""

    ' General settings (font, autofit and zoom)

     .Activate
      ActiveWindow.Zoom = 90
     .Range("A1").CurrentRegion.Rows(1).Font.Bold = True
     .Range("A1").CurrentRegion.Font.Name = "Calibri"
     .Range("A1").CurrentRegion.Font.Size = "11"
     .Range("A1").CurrentRegion.Columns.AutoFit

    ' Specific settings (header)

     .Range("A1").CurrentRegion.Interior.Color = RGB(255, 255, 255)
     .Range("A1").CurrentRegion.Rows(1).Interior.Color = RGB(166, 166, 166)
     
     Union(Range("A1").CurrentRegion.Cells(, 6), Range("A1").CurrentRegion.Cells(, 11), Range("A1").CurrentRegion.Cells(, 16), _
     Range("A1").CurrentRegion.Cells(, 21), Range("A1").CurrentRegion.Cells(, 26), Range("A1").CurrentRegion.Cells(, 31), _
     Range("A1").CurrentRegion.Cells(, 36), Range("A1").CurrentRegion.Cells(, 41), Range("A1").CurrentRegion.Cells(, 46), _
     Range("A1").CurrentRegion.Cells(, 51)).Interior.Color = RGB(216, 228, 188)

    ' Specific settings (column A + B - horizontal alignment)

     .Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row).HorizontalAlignment = xlRight
     
    ' Specific settings (column E - horizontal alignment)
     
     .Range("E2:E" & Cells(Rows.Count, 5).End(xlUp).Row).HorizontalAlignment = xlLeft

    'Clear the CurrentRegion of all groups

     On Error Resume Next
     .Range("A1").CurrentRegion.EntireColumn.Ungroup
     On Error GoTo 0

    ' Group the columns between Time1, Time2, Time3, ...
    
     .Range("B:B").Group
     .Range("G:J").Group
     .Range("L:O").Group
     .Range("Q:T").Group
     .Range("V:Y").Group
     .Range("AA:AD").Group
     .Range("AF:AI").Group
     .Range("AK:AN").Group
     .Range("AP:AS").Group
     .Range("AU:AX").Group
     .Range("AZ:BC").Group

    ' Set the group expansion to level 1

     .Outline.ShowLevels ColumnLevels:=1
     
     ' Horizontally align the Range("F2:BC")
     
     .Range("F2:BC" & Cells(Rows.Count, 5).End(xlUp).Row).HorizontalAlignment = xlCenter
     
     .Range("A1").CurrentRegion.BorderAround (xlContinuous)
     
     Union(Range("A1").CurrentRegion.Columns(6), Range("A1").CurrentRegion.Columns(11), Range("A1").CurrentRegion.Columns(16), _
     Range("A1").CurrentRegion.Columns(21), Range("A1").CurrentRegion.Columns(26), Range("A1").CurrentRegion.Columns(31), _
     Range("A1").CurrentRegion.Columns(36), Range("A1").CurrentRegion.Columns(41), Range("A1").CurrentRegion.Columns(46), _
     Range("A1").CurrentRegion.Columns(51)).Borders(xlEdgeLeft).LineStyle = xlContinuous
             
    End With
    
' Conditional Formatting
' ----------------------

lrowCount = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row

    With wsSheet1
    
    'delete all conditional formatting
    
        .Range("A2").CurrentRegion.FormatConditions.Delete
    
    '#1 format RED - the cell if the Count number is odd.
    
        With .Range("E2:E" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=MOD($E2;2)=1"
            .FormatConditions(1).Font.Color = 393372
            .FormatConditions(1).Interior.Color = 13551615
        End With

    '#2 format YELLOW - the special entry/exit codes used
    
        With .Range("F2:F" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($H2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("K2:K" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($M2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("P2:P" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($R2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("U2:U" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($W2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("Z2:Z" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AB2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("AE2:AE" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AG2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("AJ2:AJ" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AL2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("AO2:AO" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AQ2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("AT2:AT" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AV2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
        With .Range("AY2:AY" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($BA2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With
    
    '#3 format GREY - the weekends (saturday or sunday)
    
        With .Range("A1").CurrentRegion
            .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(WEEKDAY($A1)=7;WEEKDAY($A1)=1)"
            .FormatConditions(12).Interior.Color = 14277081
        End With
    
    End With

End Sub

The result can be found in the attachment. Just click the format button!

Thank you for your feedback!!!

You have some unqualified references which are best avoided, some repetition of objects that can be reduced, and turning off screenupdating is usually faster

Sub apply_all_formatting()

' Freeze panes
' ------------
    Application.ScreenUpdating = False
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With

    ' Formatting
    ' ----------

    Set wsSheet1 = Sheets("Sheet1")

    With wsSheet1

        ' Create a Table with no TableStyle

        With .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes)
            .Name = "Summary"
            .TableStyle = ""
        End With

        ' General settings (font, autofit and zoom)

        .Activate
        ActiveWindow.Zoom = 90
        With .Range("A1").CurrentRegion
            .Rows(1).Font.Bold = True
            With .Font
                .Name = "Calibri"
                .Size = "11"
            End With
            .Columns.AutoFit

            ' Specific settings (header)

            .Interior.Color = RGB(255, 255, 255)
            .Rows(1).Interior.Color = RGB(166, 166, 166)

            Union(.Cells(, 6), .Cells(, 11), .Cells(, 16), _
                  .Cells(, 21), .Cells(, 26), .Cells(, 31), _
                  .Cells(, 36), .Cells(, 41), .Cells(, 46), _
                  .Cells(, 51)).Interior.Color = RGB(216, 228, 188)
            'Clear the CurrentRegion of all groups

            On Error Resume Next
            .EntireColumn.Ungroup
            On Error GoTo 0
        End With
        ' Specific settings (column A + B - horizontal alignment)

        .Range("A2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).HorizontalAlignment = xlRight

        ' Specific settings (column E - horizontal alignment)

        .Range("E2:E" & .Cells(.Rows.Count, 5).End(xlUp).Row).HorizontalAlignment = xlLeft


        ' Group the columns between Time1, Time2, Time3, ...

        .Range("B:B").Group
        .Range("G:J").Group
        .Range("L:O").Group
        .Range("Q:T").Group
        .Range("V:Y").Group
        .Range("AA:AD").Group
        .Range("AF:AI").Group
        .Range("AK:AN").Group
        .Range("AP:AS").Group
        .Range("AU:AX").Group
        .Range("AZ:BC").Group

        ' Set the group expansion to level 1

        .Outline.ShowLevels ColumnLevels:=1

        ' Horizontally align the Range("F2:BC")

        .Range("F2:BC" & .Cells(.Rows.Count, 5).End(xlUp).Row).HorizontalAlignment = xlCenter

        .Range("A1").CurrentRegion.BorderAround xlContinuous
        With .Range("A1").CurrentRegion
            Union(.Columns(6), .Columns(11), .Columns(16), _
                  .Columns(21), .Columns(26), .Columns(31), _
                  .Columns(36), .Columns(41), .Columns(46), _
                  .Columns(51)).Borders(xlEdgeLeft).LineStyle = xlContinuous
        End With

        ' Conditional Formatting
        ' ----------------------

        lrowCount = .Cells(.Rows.Count, 5).End(xlUp).Row


        'delete all conditional formatting

        .Range("A2").CurrentRegion.FormatConditions.Delete

        '#1 format RED - the cell if the Count number is odd.

        With .Range("E2:E" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=MOD($E2;2)=1"
            .FormatConditions(1).Font.Color = 393372
            .FormatConditions(1).Interior.Color = 13551615
        End With

        '#2 format YELLOW - the special entry/exit codes used

        With .Range("F2:F" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($H2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("K2:K" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($M2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("P2:P" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($R2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("U2:U" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($W2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("Z2:Z" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AB2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("AE2:AE" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AG2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("AJ2:AJ" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AL2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("AO2:AO" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AQ2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("AT2:AT" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($AV2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        With .Range("AY2:AY" & lrowCount)
            .FormatConditions.Add Type:=xlExpression, Formula1:="=LEN($BA2)>0"
            .FormatConditions(1).Font.Color = 26012
            .FormatConditions(1).Interior.Color = 10284031
        End With

        '#3 format GREY - the weekends (saturday or sunday)

        With .Range("A1").CurrentRegion
            .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(WEEKDAY($A1)=7;WEEKDAY($A1)=1)"
            .FormatConditions(12).Interior.Color = 14277081
        End With

    End With

End Sub

Is there a specific part of your code that takes longer than you feel it should? How long does the code take before making any changes to it?

As xlnitwit has posted screenupdating can help in general. They have also done some spring cleaning on the code.

I also notice you get the last row many times throughout your code instead of getting it once and storing it in a variable to reuse (You eventually do but after having used it multiple times prior).

You could also use constants for many of the repeated values you use in your code (ie: "10284031"). Constants can help speed up your code and make it easier to update when 1 value is used many times in your code.

Also how does your data work? You obviously update the file and thus need to remove formatting and re-apply it. Are you removing old data and replacing it with new data, appending new data to old data, etc?

However you are going about it, if the layout of the data doesnt change, you may consider instead setting things up so that as much of the formatting as possible stays in place and making it dynamically expand/collapse based on the data.

So for example it may be quicker to simply expand the ranges the conditional formats are applied to instead of removing all the conditional formats and recreating them again.

Even if this is new raw data being dumped onto a blank sheet, you could still have a template sheet that you copy, dump the info on, and expand some of the formatting to match the dumped data. In this fashion you can avoid things like applying the table, setting freeze panes, adjusting zoom level, setting alignment, etc.

Depending how you get the data into the destination, you may even be able to paste it matching destination formats. This would allow you to format the "template" sheet 1 time and then maintain the basic formats (like font, size, etc) everytime you use the template to make a new sheet and dump data from it.

Thanks xlnitwit. I'll pay more attention to with/end with.

You must spread some Reputation around before giving it to xlnitwit again.

Sorry man, still can't rep you

Ill review it see if we can come up with some ideas...

Off the top of my head, at a glance is more of what I pointed out. You have many opportunities to declare variables and constants to help cleanup your code and potentially speed it up.

In codeLoadData for example you use "ThisWorkbook." multiple times. If you set this to a workbook variable and/or combine it with "With" statements you can simplify your code.

Also, in declaring variables something like:

Dim Filt, title As String

means title is a string type, Filt ends up not being given a type so it defaults to a variant. Not a huge deal but good to get in the habit of assigning variables the data type that best fits them.

You have some public constants declared already, but use them in some modules and not others. You also use a variable in some places instead of a constant.

Filt = "Excel files (*.xlsx;*.xlsm;*.xls),*.xlsx;*.xlsm;*.xls"

So you stored this string which is static in a variant type variable instead of a string constant. Then in another routine you declare it again and set it to the same string again. Doing this as a public constant would make alot more sense.

In building out the data you clear the whole summary sheet then re-add the headers using a static array...why not just clear everything under the headers and leave them? You could also store all those headers in a string constant, seperated by comma's and then split them into an array.

Also no need to loop cells to dump an array into a range (for the headers). You can dump an array into a range of the same dimensions. Ill attach a sample of this method. Any time you can avoid looping cells, do so. Looping cells is very slow (maybe not noticeable in the headers, but in larger data sets it comes at a price)

Range.value = array

In case it helps heres my code snippet for how I clear a table to reuse it:

Option Explicit 

'******CONSTANTS****************************************************** 
'Constant for number 1 
Const intOne As Integer = 1 

'This sub takes a table arguement and clears the contents 
'so that the table has its data body range cleared 
'leaving it with a single row in the data body range without destroying formulas 

'Zer0Cool
'excelforum.com
'1/27/2017 

'Created in Excel 2013 
Private Sub ClearTable(lstTbl As ListObject) 

'Error Handler 
On Error GoTo Handler 

'******CODE BODY****************************************************** 
'Ensure the databodyrange has at least 1 row. 
'Even when a row is visible the count can still be 0 
With lstTbl.ListRows 
    If .Count < intOne Then 
        .Add 
    End If 
End With 

'Clear the first row in databodyrange 
'Delete all other rows in databodyrange 
With lstTbl.DataBodyRange 
    'Delete rows beyond the first 
    If .Rows.Count > intOne Then 
        .Offset(intOne, 0).Resize(.Rows.Count - intOne, .Columns.Count).Rows.Delete 
    End If 

    'First row cleanup 
    .Rows(intOne).ClearContents 'Clears all contents 
    '.Rows(intOne).ClearFormats 'Clears all of formatting only 
    'Clearing constants only (leaves formulas) *Requires checking for error 1004 (no constants exist). Done in error handler 
    '.SpecialCells(xlCellTypeConstants).ClearContents 
End With 

'******EXIT CODE****************************************************** 
Exit_Sub: 
    Exit Sub
 
'******ERROR HANDLER************************************************** 
Handler: 
    Select Case Err.Number 
        Case 1004 'Corrects issue with clearing constant cells if none are there 
            If Left(Err.Description, 20) = "No cells were found." Then 
                Resume Next 
            Else 'All other 1004 errors 
                MsgBox "Error" & Err & ": " & Error(Err) & "." 
                GoTo Exit_Sub 
            End If 
        Case Else 'any other error 
            MsgBox "Error" & Err & ": " & Error(Err) & "." 
            GoTo Exit_Sub 
    End Select 
End Sub 

'Sample call to ClearTable 

'Zer0Cool 
'excelforum.com
'1/27/2017 

'Created in Excel 2013 
Sub RunMacro() 

'******DECLARATIONS*************************************************** 
Dim wbThis As Workbook 
Dim wsSht As Worksheet 
Dim lstT As ListObject 

'Error Handler 
On Error GoTo Handler 

'******PREPERATION**************************************************** 
Application.ScreenUpdating = False 'Uncomment if needed 

Set wbThis = ThisWorkbook 

'******CODE BODY****************************************************** 
For Each wsSht In wbThis.Worksheets 
    For Each lstT In wsSht.ListObjects 
        Call ClearTable(lstT) 
    Next 
Next 

'******EXIT CODE****************************************************** 
Exit_Sub: 
    Application.ScreenUpdating = True 'Uncomment if needed 
    Exit Sub 

'******ERROR HANDLER************************************************** 
Handler: 
    MsgBox "Error" & Err & ": " & Error(Err) & "." 
    GoTo Exit_Sub 
End Sub

I see loops going through cells and using find. If the same goal can be accomplished using filters, filter the data to what you want then copy/paste the range of visible results as needed. Should be a good deal faster than find in a loop.

Another thing to point out.

If you have routines call others...lets say for example routine 1 calls routine 2 calls routine 3. If routine 1 has screen updating turned off, you do NOT need to do so for the routines it calls as its already off (same for calculation mode, events, etc).

Thumbs up for reviewing.

I'll try to work with variables and with/end with more, but I'm only learning my doing.
Heck, I just discovered that I applied formatting to my header row twice!

This is my first real project and I'm already very happy with the results.
The only VBA I ever did before was a userform to e-mail project.

Br,

Bram

We all start some place. One of my favorite things to do is look at code I wrote 1, 2, 5 years in the past. Alot of "wtf was I thinking?!?!". Then you update your code, learn some new stuff and get even better at it.

However if you really have an interest in learning VBA, I would recommend getting a book or watching some videos on the fundamentals of VBA. Variables and scope, error handling, object model, common algorithms, loops, etc.

Learning the proper ways to approach VBA coding is alot easier when you haven't developed bad habits.

So what I would recommend (and do myself) is plan your VBA project before writing any code. I make an outline bullet pointing the key aspects of what my macro needs to do, in a logical order it has to be done in.

For example:

1. Create a template sheet with headers/empty table row and formatting
2. Get data from x file into table
3. Set groupings
4. Expand conditional formats
5. etc...

Once I have an outline I start thinking about and declaring my variables. I start with global/public variables and constants, the ones I will use across my whole project. It might be things like workbook, worksheet, a specific range, strings, etc.

The 2 above steps set a pretty clear path from that point how I am going to write my code. I start to expand on my outline as I write the code to account for new considerations ideas, like looping, error handling something unexpected, etc.

Lastly one of the best things you can do to help yourself is save snippets of code someplace thats easy to get to them. I have snippets of code, like the table clearing code I gave you. I have the code in OneNote and I keep sample files demonstrating the code in a folder. Its pretty much a daily occurrence I go and pull something from my snippets/samples. I have well over 100 Excel sample files I have created so I do not need to relearn/re-write stuff I have already tested and used.

I even have in my personal workbook templates for a new sub routine and new function so I dont need to rewrite the commented "sections" in my code or the generic error handlers I use.