Conditional Formatting multiple tables the same way - VBA

[choop]

Hello,

I have a spreadsheet with about 7 identical (same headings, columns) tables. Those 7 tables are lists of employees for each of our seven plants. In addition to employee names, it includes a bunch of detail about job, manager, etc.

I have about 8 or 10 conditional formattings that I would like to use, but i'm finding that Excel gets very confused when I copy and paste data between tabs, or add new rows.

I would like to have a macro that can cycle through each of the tabs, clear all conditional formatting, and then re-apply my pre-defined conditional formatting. The trick is that the number of rows isn't the same between the tables, so ranges aren't a good option, the code would really need to apply to the table.Column itself so it dynamically incorporates all data, while leaving blank rows as regular formatting.

Tables:

Plant1​

Plant2​

etc...​

Columns include:

Site​

Baseline Employee​

EE Number​

SEGMENT​

Role Origination Date​

IN WORKDAY?​

Manager Name​

Shift​

Workday Title​

Simplifed Business Title​

Title-Shift​

B/V/SGA​

Comment​

January​

February​

March​

April​

May​

June​

July​

August​

September​

October​

November​

December​

Is this possible?

thanks

 

[Yongle]

One way
Create a "Model" sheet with required conditional formatting rules set up for a big enough range so that it can be copies to any sheet and still work
Loop sheets to be dealt with
Delete all old conditions
Copy formatting from Model sheet

Something like this:

Sub ConditionalFormatting()
    Dim sh As Variant
    Const rng = "A2:E34"

    For Each sh In Array("Sheet1", "Sheet2")
        Sheets(sh).Cells.FormatConditions.Delete
        Sheets("Model").Range(rng).Copy
        Sheets(sh).Range(rng).PasteSpecial (xlPasteFormats)
    Next sh
End Sub

If your

 

[choop]

This could work - the only problem is the conditional formatting will look goofy for some of the smaller plants where the formatting would go below the length of the table. Any way to incorporate a check rows to limit the paste to only the impacted rows?

thank you!

 

[Yongle]

There is a way to deal with that if required
But before we complicate the code, have you tried it with tables that are very small?

 

[choop]

The code is executing without error, but doesn't seem to to working. The old format rules are remaining and copying the model formats doesn't seem to have an impact. I have it included inside another for loop, but that loop is working for the other code. I changed the "Sheets("MODEL"), to "sheet22." because the first wasn't working, but mine isn't working either.

Here is a snippet:

For Each ws In Array(Sheet4, Sheet5, Sheet6, Sheet7, Sheet8, Sheet10)

On Error Resume Next​

ws.Activate​

ActiveWindow.FreezePanes = False​

ActiveWindow.DisplayGridlines = True​

ActiveWindow.ScrollRow = 1 'the row you want to scroll to​

ActiveWindow.ScrollColumn = 1 'the column you want to scroll to​

Range("a2").Select​

ActiveWindow.Zoom = 100​

ActiveWindow.FreezePanes = True​

Range("A2").Select​

ActiveWindow.ScrollRow = 1 'the row you want to scroll to​

ActiveWindow.ScrollColumn = 1 'the column you want to scroll to​

​

'Conditional Formatting​

Sheets(ws).Cells.FormatConditions.Delete​

Sheet22.Range(rng).Copy​

Sheets(sh).Range(rng).PasteSpecial (xlPasteFormats)​

Next ws

 

[choop]

here is a bit more of the function so you have more context:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)​

Dim CurrentSheet As Worksheet​

Set CurrentSheet = ActiveSheet​

Dim ws As Variant​

Const rng = "A2:AB225"​

​

Application.ScreenUpdating = False​

For Each ws In Array(Sheet4, Sheet5, Sheet6, Sheet7, Sheet8, Sheet10)​

'On Error Resume Next​

ws.Activate​

ActiveWindow.FreezePanes = False​

ActiveWindow.DisplayGridlines = True​

ActiveWindow.ScrollRow = 1 'the row you want to scroll to​

ActiveWindow.ScrollColumn = 1 'the column you want to scroll to​

Range("a2").Select​

ActiveWindow.Zoom = 100​

ActiveWindow.FreezePanes = True​

Range("A2").Select​

ActiveWindow.ScrollRow = 1 'the row you want to scroll to​

ActiveWindow.ScrollColumn = 1 'the column you want to scroll to​

​

'Conditional Formatting​

'ActiveSheet.ListObjects("Table1").ListColumns(3).DataBodyRange.Select​

Sheets(ws).Cells.FormatConditions.Delete​

Sheet22.Range(rng).Copy​

Sheets(ws).Range(rng).PasteSpecial (xlPasteFormats)​

​

​

​

Next ws​

 

[Fluff]

How about

With ws.ListObjects(1).DataBodyRange
   .FormatConditions.Delete
   Sheet22.ListObjects(1).DataBodyRange.Copy
   .PasteSpecial xlPasteFormats
End With

 

[choop]

This seems to work! It doesn't delete the old conditional formatting for some cells (seems like mainly in row 1, the header), but it does seem to copy the formatting.

I changed to to this and I think it is working as expected now:

With ws.ListObjects(1).DataBodyRange​

Range("A1:AB300").FormatConditions.Delete​

Sheet22.ListObjects(1).DataBodyRange.Copy​

.PasteSpecial xlPasteFormats​

End With​

Thank you so much!

Chris

 

[Fluff]

Do you mean you have conditional formatting on the header row?

 

[choop]

It seems like it was already there inadvertently probably due to copy/paste over time (ie. this is the main reason i was trying to do this code int he first place). I assume there is a more elegant way to capture the whole table for deleting conditions?