workbook wide VBA conditional formatting help

Brad_Miller

Board Regular
Joined
Sep 18, 2014
Messages
56
Please can one of you geniuses excel guys or ladies help me with a bit of code to format an entire spreadsheet.

I have a excel workbook with our entire hospitals directory.
Each section of the hospital has a different colour code and I need to conditionally format the entire workbook based on these codes.
Only one cell needs the colour change and the colur is depeant on the value of the directly opposite cell

here is the colour references I have to assign to the cell based on the other cells value
1605801393776.png


and an example of the data
column A is where the colour needs to be applied and based on value in column G
1605801524716.png


I have tried condition formatting but there are merged rows so it screws up the entire layout so I would imagine some vbs would be the better thing to use?

I have resorted to copying the format and manually applying to the cell based on column G value :(
thanks a million
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
Try this Vba script. Check all spelling.

Try this in one sheet and if it works tell me what sheets you want this to run in.
Say something like all sheets or sheets 5 to last sheet or sheet 7 to sheet 25

VBA Code:
Sub Color_My_Cells()
'Modified  11/21/2020  5:21:55 PM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "G").End(xlUp).Row

For i = 1 To Lastrow
    Select Case Cells(i, "G").Value
        Case "Block House Building": Cells(i, 1).Interior.Color = RGB(96, 111, 84)
        Case "South Building": Cells(i, 1).Interior.Color = RGB(182, 170, 152)
        Case "Arwyp Main Building": Cells(i, 1).Interior.Color = RGB(104, 90, 83)
        Case "Central Street Parking": Cells(i, 1).Interior.Color = RGB(126, 126, 126)
        Case "Arwyp Medical Suites": Cells(i, 1).Interior.Color = RGB(136, 164, 154)
        Case "Arwyp Training Centre": Cells(i, 1).Interior.Color = RGB(164, 200, 229)
        Case "Arwyp Customer Centre": Cells(i, 1).Interior.Color = RGB(20, 111, 155)
        Case "Casuaty and OPD": Cells(i, 1).Interior.Color = RGB(254, 0, 0)
        Case "Staff Block": Cells(i, 1).Interior.Color = RGB(233, 239, 248)
    End Select
Next

Application.ScreenUpdating = True
End Sub
 
Upvote 0
If you want to do this on all the sheets in your Workbook try this:
VBA Code:
Sub Color_My_Cells()
'Modified  11/22/2020  1:48:39 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim ans As Long
Dim b As Long
ans = ThisWorkbook.Sheets.Count

For b = 1 To ans
    Lastrow = Sheets(b).Cells(Rows.Count, "G").End(xlUp).Row
        For i = 1 To Lastrow
            With Sheets(b)
                Select Case .Cells(i, "G").Value
                    Case "Block House Building": .Cells(i, 1).Interior.Color = RGB(96, 111, 84)
                    Case "South Building": .Cells(i, 1).Interior.Color = RGB(182, 170, 152)
                    Case "Arwyp Main Building": .Cells(i, 1).Interior.Color = RGB(104, 90, 83)
                    Case "Central Street Parking": .Cells(i, 1).Interior.Color = RGB(126, 126, 126)
                    Case "Arwyp Medical Suites": .Cells(i, 1).Interior.Color = RGB(136, 164, 154)
                    Case "Arwyp Training Centre": .Cells(i, 1).Interior.Color = RGB(164, 200, 229)
                    Case "Arwyp Customer Centre": .Cells(i, 1).Interior.Color = RGB(20, 111, 155)
                    Case "Casuaty and OPD": .Cells(i, 1).Interior.Color = RGB(254, 0, 0)
                    Case "Staff Block": .Cells(i, 1).Interior.Color = RGB(233, 239, 248)
                End Select
            End With
        Next
Next
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
If you want to do this on all the sheets in your Workbook try this:
VBA Code:
Sub Color_My_Cells()
'Modified  11/22/2020  1:48:39 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim ans As Long
Dim b As Long
ans = ThisWorkbook.Sheets.Count

For b = 1 To ans
    Lastrow = Sheets(b).Cells(Rows.Count, "G").End(xlUp).Row
        For i = 1 To Lastrow
            With Sheets(b)
                Select Case .Cells(i, "G").Value
                    Case "Block House Building": .Cells(i, 1).Interior.Color = RGB(96, 111, 84)
                    Case "South Building": .Cells(i, 1).Interior.Color = RGB(182, 170, 152)
                    Case "Arwyp Main Building": .Cells(i, 1).Interior.Color = RGB(104, 90, 83)
                    Case "Central Street Parking": .Cells(i, 1).Interior.Color = RGB(126, 126, 126)
                    Case "Arwyp Medical Suites": .Cells(i, 1).Interior.Color = RGB(136, 164, 154)
                    Case "Arwyp Training Centre": .Cells(i, 1).Interior.Color = RGB(164, 200, 229)
                    Case "Arwyp Customer Centre": .Cells(i, 1).Interior.Color = RGB(20, 111, 155)
                    Case "Casuaty and OPD": .Cells(i, 1).Interior.Color = RGB(254, 0, 0)
                    Case "Staff Block": .Cells(i, 1).Interior.Color = RGB(233, 239, 248)
                End Select
            End With
        Next
Next
Application.ScreenUpdating = True
End Sub
I assume your t
@My Aswer Is This

Thank you ever so much your code works like a bomb!
you have saved me!
Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.
 
Upvote 0
In case your interested I have another solution you may like.
I would suggest you use a Data Validation list in all your sheets in column G
This is so users can only enter certain values in column G
That would be the names you provided in your post.

Now if you installed this script as I explain below when a User selected a value in the Data Validation list which entered the value in column G the script like you wanted would run automatically in that sheet.
The script would work in all sheets in your workbook automatically in that sheet.

This way you would not have to run the script I provided earlier.

The script automatically runs when you enter a value in column G of any sheet.
If you enter the proper name in the cell.


This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on any sheet tab
Select View Code from the pop-up context menu
In left upper corner of window double click on Thisworkbook
Paste the code in the VBA edit window

VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Modified  11/22/2020  11:54:44 PM  EST
If Target.Cells.CountLarge > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Column = 7 Then

                Select Case Target.Value
                    Case "Block House Building": Target(, -5).Interior.Color = RGB(96, 111, 84)
                    Case "South Building": Target(, -5).Interior.Color = RGB(182, 170, 152)
                    Case "Arwyp Main Building": Target(, -5).Interior.Color = RGB(104, 90, 83)
                    Case "Central Street Parking": Target(, -5).Interior.Color = RGB(126, 126, 126)
                    Case "Arwyp Medical Suites": Target(, -5).Interior.Color = RGB(136, 164, 154)
                    Case "Arwyp Training Centre": Target(, -5).Interior.Color = RGB(164, 200, 229)
                    Case "Arwyp Customer Centre": Target(, -5).Interior.Color = RGB(20, 111, 155)
                    Case "Casuaty and OPD": Target(, -5).Interior.Color = RGB(254, 0, 0)
                    Case "Staff Block": Target(, -5).Interior.Color = RGB(233, 239, 248)
                End Select
End If
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top