Home/ Questions/Q 763431
In Process

The Archive Base Latest Questions

Editorial Team
  • 0
Asked: 2026-05-14T16:33:32+00:00

I have VBA code in an Excel spreadsheet. It is used to set the

  • 0

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.

Share

Leave an answer

You must login to add an answer.

Need An Account,

1 Answer

  1. Editorial Team

    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
    • 0