VBA Conditional Formatting

L

landloched

New Member
Joined
Dec 16, 2021
Messages
4
Office Version
  1. 365
Platform
  1. Windows
Hello all,
Been trying to figure this out for awhile.
Conditional Formatting is no use, since I want to copy and paste this formatting to several hundred cells, and I would have to go in and edit each individual condition for each individual cell in each individual range.
It baffles me how it doesn't change the reference when trying to paste it like every other formula for excel.

So I have a range of cells that need to change color whenever one of those cells(a predetermined cell) has a certain value.
This is a schedule by day by person
1639681809183.png

The issue is each range of cells has to have 8 different conditions. If d7=close then "this color" but if d7=open then "that color". Then repeat all 8 formulas for Tuesday i.e. if g7=close then.... and so on until Sunday. And then repeat again for the next employee.
I'm new to VBA and don't now the syntax to write this. Please help!
 

Attachments

  • 1639681708434.png
    1639681708434.png
    3.3 KB · Views: 6

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
You might consider the following...

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row

If Not Intersect(Target, Range("D7:V" & LastRow)) Is Nothing Then
    Select Case Target
        Case "Production"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 3
        Case "Order Writer"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 4
        Case "OW/Open"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 6
        Case "Open"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 7
        Case "Early Mid"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 8
        Case "Late Mid"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 20
        Case "Close"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 24
        Case "Inventory"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 44
    End Select
End If
End Sub

The code should be Copied/Pasted into your Sheet module, not a standard code module.

The color change is dependent on the value in the Shift Title, eg, cell D7 or cell G7...

Choose your own colors from the ColorIndex values.

Cheers,

Tony
 
Upvote 0
Solution
tonyyy said:
You might consider the following...

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row

If Not Intersect(Target, Range("D7:V" & LastRow)) Is Nothing Then
    Select Case Target
        Case "Production"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 3
        Case "Order Writer"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 4
        Case "OW/Open"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 6
        Case "Open"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 7
        Case "Early Mid"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 8
        Case "Late Mid"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 20
        Case "Close"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 24
        Case "Inventory"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 44
    End Select
End If
End Sub

The code should be Copied/Pasted into your Sheet module, not a standard code module.

The color change is dependent on the value in the Shift Title, eg, cell D7 or cell G7...

Choose your own colors from the ColorIndex values.

Cheers,

Tony
Click to expand...
you are an absolute angel! that's better than I could've hoped for. Thank you so much!
 
Upvote 0
tonyyy said:
You might consider the following...

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row

If Not Intersect(Target, Range("D7:V" & LastRow)) Is Nothing Then
    Select Case Target
        Case "Production"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 3
        Case "Order Writer"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 4
        Case "OW/Open"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 6
        Case "Open"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 7
        Case "Early Mid"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 8
        Case "Late Mid"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 20
        Case "Close"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 24
        Case "Inventory"
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 44
    End Select
End If
End Sub

The code should be Copied/Pasted into your Sheet module, not a standard code module.

The color change is dependent on the value in the Shift Title, eg, cell D7 or cell G7...

Choose your own colors from the ColorIndex values.

Cheers,

Tony
Click to expand...
one quick question. How do I get a blank cell to reset the color? Currently if I delete the job title, the color stays the same
 
Upvote 0
Here is a different solution that does not require you to look up color codes.

Create a new sheet called Keys
In column A, list the values that you have in the dropdown
Color each cell the desired color

Use this code in the worksheet module for your data.
Deleting the data in the cell to leave it blank will reset the color.
Also this code only executes for the Shift Title cells, which may speed things up a bit.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  
   Dim Found As Range
   Dim FillColor As Long

   If Target.Row Mod 7 = 0 Then
     
      Set Found = Worksheets("Key").Range("A:A").Find(what:=Target.Value)
      FillColor = Found.Interior.Color
      Target.Offset(-1, 0).Resize(6, 3).Interior.Color = FillColor
     
   End If
     
End Sub

Also, merged cells are nearly always a bad idea and can wreak havoc. I do not see why this sheet needs to have merged cells. I would consider a redesign to eliminate them, such as splitting your times onto two rows.
 
Upvote 0
6StringJazzer said:
Here is a different solution that does not require you to look up color codes.

Create a new sheet called Keys
In column A, list the values that you have in the dropdown
Color each cell the desired color

Use this code in the worksheet module for your data.
Deleting the data in the cell to leave it blank will reset the color.
Also this code only executes for the Shift Title cells, which may speed things up a bit.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 
   Dim Found As Range
   Dim FillColor As Long

   If Target.Row Mod 7 = 0 Then
    
      Set Found = Worksheets("Key").Range("A:A").Find(what:=Target.Value)
      FillColor = Found.Interior.Color
      Target.Offset(-1, 0).Resize(6, 3).Interior.Color = FillColor
    
   End If
    
End Sub

Also, merged cells are nearly always a bad idea and can wreak havoc. I do not see why this sheet needs to have merged cells. I would consider a redesign to eliminate them, such as splitting your times onto two rows.
Click to expand...
I appreciate the input but the first solution is a lot easier for what I'm looking for, and the merged cells are necessary for the format, and nothing about the merged cells are what's causing my issues with conditional formatting anyway, and they aren't wreaking havoc or causing any problems whatsoever.
 
Upvote 0
"one quick question. How do I get a blank cell to reset the color? Currently if I delete the job title, the color stays the same"

Add another case for a blank cell...

VBA Code: 
        Case ""
            Target.Offset(-1, 0).Resize(6, 3).Interior.ColorIndex = 0
 
Upvote 0
6StringJazzer said:
Here is a different solution that does not require you to look up color codes.

Create a new sheet called Keys
In column A, list the values that you have in the dropdown
Color each cell the desired color

Use this code in the worksheet module for your data.
Deleting the data in the cell to leave it blank will reset the color.
Also this code only executes for the Shift Title cells, which may speed things up a bit.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 
   Dim Found As Range
   Dim FillColor As Long

   If Target.Row Mod 7 = 0 Then
    
      Set Found = Worksheets("Key").Range("A:A").Find(what:=Target.Value)
      FillColor = Found.Interior.Color
      Target.Offset(-1, 0).Resize(6, 3).Interior.Color = FillColor
    
   End If
    
End Sub

Also, merged cells are nearly always a bad idea and can wreak havoc. I do not see why this sheet needs to have merged cells. I would consider a redesign to eliminate them, such as splitting your times onto two rows.
Click to expand...
Hello... ok so this code is brilliant, thank you!... as 've taken it too, and managed to adjust it to work almost as i need it to but, i can´t work out how to restrict it to range A1:GG50 (i don't want it to work on any cells below row 50, alternatively it could be changed so it needs to be an exact match maybe? (at the moment, if i change a colour name in the key worksheet A:A to '1' or 'one' say, then the formula applies that colour when i type '10' or 'twentyone' say, and i need 25 different colours, so I was hoping to give each key colour a sequential number... LASTLEY!... it would be wonderful if, the code will allow me to type other characters than those in the key, as i want to be able to add other info in the range and at the moment, i get run-time error '91'.... i hope this all makes sense!? TIA...

T
 
Upvote 0
novabond said:
Hello... ok so this code is brilliant, thank you!... as 've taken it too, and managed to adjust it to work almost as i need it to but, i can´t work out how to restrict it to range A1:GG50 (i don't want it to work on any cells below row 50, alternatively it could be changed so it needs to be an exact match maybe? (at the moment, if i change a colour name in the key worksheet A:A to '1' or 'one' say, then the formula applies that colour when i type '10' or 'twentyone' say, and i need 25 different colours, so I was hoping to give each key colour a sequential number... LASTLEY!... it would be wonderful if, the code will allow me to type other characters than those in the key, as i want to be able to add other info in the range and at the moment, i get run-time error '91'.... i hope this all makes sense!? TIA...

T
Click to expand...
sorry pressed return to soon...

my version of the code is:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Found As Range
Dim FillColor As Long

If Target.Row Mod 1 = 0 Then

Set Found = Worksheets("Key").Range("A:A").Find(what:=Target.Value)
FillColor = Found.Interior.Color
Target.Offset(1, 0).Resize(20, 1).Interior.Color = FillColor

End If

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Question
Multiple Checkboxes / Conditional formatting
Replies
5
Views
139
trevolly
T
B
  • Solved
Count Coloured cells
2
Replies
10
Views
389
baileyb103
B
J
  • Solved
How to apply changing conditional formatting to an array of columns
2
Replies
12
Views
335
Peter_SSs
Peter_SSs
J
  • Solved
Dont fix cell colour if cell has no Interior colour or Conditional Formatting
2
Replies
11
Views
354
Joe4
Joe4
J
  • Question
Conditional formatting based on value of another cell
Replies
3
Views
235
etaf
etaf

Forum statistics

Threads
1,214,943
Messages
6,122,380
Members
449,080
Latest member
Armadillos

Share this page

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