Set the background color for a fixed range of cells
So c.Range("A1:D1")
has its own relative range.
One solution is to use the worksheet's range property instead.
I added two lines towards the top (#added
), and changed one at the bottom (#changed
).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, d As Range, fc As Long, bc As Long, bf As Boolean
Dim ws As Worksheet ''#added
Set d = Intersect(Range("A:K"), Target).Cells
Set ws = d.Worksheet ''#added
If d Is Nothing Then Exit Sub
For Each c In d.Cells
If c >= Date And c <= Date + 5 Then
fc = 2: bf = True: bc = 3
Else
Select Case c.Value
Case "ABC"
fc = 2: bf = True: bc = 5
Case 1, 3, 5, 7
fc = 2: bf = True: bc = 1
Case "D", "E", "F"
fc = 2: bf = True: bc = 10
Case "1/1/2009"
fc = 2: bf = True: bc = 45
Case "Long string"
fc = 3: bf = True: bc = 1
Case Else
fc = 1: bf = False: bc = xlNone
End Select
End If
c.Font.ColorIndex = fc
c.Font.Bold = bf
c.Interior.ColorIndex = bc
ws.Cells(c.Row, 1).Interior.ColorIndex = bc ''#changed
ws.Cells(c.Row, 2).Interior.ColorIndex = bc ''#added
ws.Cells(c.Row, 3).Interior.ColorIndex = bc ''#added
ws.Cells(c.Row, 4).Interior.ColorIndex = bc ''#added
Next
End Sub
Count Boxer
I cut my programming teeth writing user exit routines for CA-SORT in 370 Assembler for an IBM 4381 I then transitioned to application programming in COBOL for the banking industry including a few years preparing for Y2K The next shift was to web development which started with static HTML and then progressed thru VBScript to PHP but always with a database backend I'm currently specializing in scripting languages like Python and Ruby (and their associated frameworks) with a side interest in Android and non-relational databases
Updated on June 25, 2022Comments
-
Count Boxer almost 2 years
I have VBA code in an Excel spreadsheet. It is used to set the font and background color of a cell based on the value in that cell. I am doing it in VBA instead of "Conditional Formatting" because I have more than 3 conditions. The code is:
Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, d As Range, fc As Long, bc As Long, bf As Boolean Set d = Intersect(Range("A:K"), Target) If d Is Nothing Then Exit Sub For Each c In d If c >= Date And c <= Date + 5 Then fc = 2: fb = True: bc = 3 Else Select Case c Case "ABC" fc = 2: fb = True: bc = 5 Case 1, 3, 5, 7 fc = 2: fb = True: bc = 1 Case "D", "E", "F" fc = 2: fb = True: bc = 10 Case "1/1/2009" fc = 2: fb = True: bc = 45 Case "Long string" fc = 3: fb = True: bc = 1 Case Else fc = 1: fb = False: bc = xlNone End Select End If c.Font.ColorIndex = fc c.Font.Bold = fb c.Interior.ColorIndex = bc c.Range("A1:D1").Interior.ColorIndex = bc Next End Sub
The problem is in the "c.Range" line. It always uses the current cell as "A" and then goes four cells to the right. I want it to start in the "real" cell "A" of the current row and go to the "real" cell "D" of the current row. Basically, I want a fixed range and not a dynamic one.