Coloring cells VBA

FadDak

New Member
Joined
Nov 29, 2023
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
I am currently working on a project in VBA Excel, and I've encountered an issue with dynamically changing the color of cells based on a numerical threshold. The specific challenge is that I want cells in column A to turn green if the value is above 100,000 and red if it's 100,000 or below. Despite my attempts, I haven't been able to get the VBA code to respond correctly to these conditions.

Thank you in advance for your assistance.
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Maybe something like this:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
    Select Case Target.Value
        Case Is > 100000
            Target.Interior.Color = vbGreen
        Case Is <= 100000
            Target.Interior.Color = vbRed
    End Select
End If
Application.EnableEvents = True
End Sub
 
Upvote 0
As dreid1011 showed, it is not hard to do via VBA. All things equal, there are usually a few good reasons to use Conditional Formatting over VBA for something like this:
1. Why use VBA to create built-in Excel functionality that already exists?
2. Code will only run if VBA is enabled for the workbook (and VBA cannot be run in web version of Excel)
3. Related to 2 above, many users will not enable VBA for security concerns (or workplace security forbids it)

Perhaps there are good reasons for wanting to use VBA, i.e. maybe it is part of a larger VBA project.
 
Upvote 0
Maybe something like this:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
    Select Case Target.Value
        Case Is > 100000
            Target.Interior.Color = vbGreen
        Case Is <= 100000
            Target.Interior.Color = vbRed
    End Select
End If
Application.EnableEvents = True
End Sub
Added a line to account for blank values after already having had a value.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A1:A100")) Is Nothing Then
    Select Case Target.Value
        Case ""
            Target.Interior.Color = xlNone
        Case Is > 100000
            Target.Interior.Color = vbGreen
        Case Is <= 100000
            Target.Interior.Color = vbRed
    End Select
End If
Application.EnableEvents = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,102
Messages
6,123,097
Members
449,096
Latest member
provoking

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