workbook wide VBA conditional formatting help

Brad_Miller

Board Regular
Joined
Sep 18, 2014
Messages
52
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
 

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,247
Office Version
  1. 2013
Platform
  1. Windows
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
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,247
Office Version
  1. 2013
Platform
  1. Windows
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
 
Solution

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,247
Office Version
  1. 2013
Platform
  1. Windows
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.
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,247
Office Version
  1. 2013
Platform
  1. Windows
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:

Watch MrExcel Video

Forum statistics

Threads
1,118,134
Messages
5,570,356
Members
412,320
Latest member
sixnine0312
Top