Solved

VBA to change colors

Posted on 2012-03-14
4
447 Views
Last Modified: 2012-03-15
Hi Guys, what would be the code for

If Range(S6:S450) >=38.75 then VB red, else VB white

If (S6:S450) >=38.75 then Range(B6:B450)VB red, else VB white

I need the code to activate these 2 columns depending on Column S values

I did this with conditional format but it slows down my sheet operation.
0
Comment
Question by:rsen1
  • 2
  • 2
4 Comments
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 37723117
It's unlikely that VBA will be faster than Conditional Formatting.  Indeed, it would probably be slower to use VBA with a Change or Calculate event sub than to just use CF.
0
 

Author Comment

by:rsen1
ID: 37723123
Thank you for your response, but would you please help me with code all the same?
0
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 37723159
I still think that this is a bad idea, but if you insist, this goes in the sheet module for the worksheet you need to "watch":


Option Explicit

Private Sub Worksheet_Calculate()
    
    ApplyColors
    
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Me.[s6:s450]) Is Nothing Then
        ApplyColors Intersect(Target, Me.[s6:s450])
    End If
    
End Sub

Private Sub ApplyColors(Optional rng As Range)
    
    Dim UseThisRange As Range
    Dim cel As Range
    
    Const Threshold As Double = 38.75
    
    Application.EnableEvents = False
    
    If Not rng Is Nothing Then
        Set UseThisRange = rng
    Else
        Set UseThisRange = Intersect(Me.UsedRange, Me.[s6:s450])
    End If
    
    For Each cel In UseThisRange.Cells
        If cel >= Threshold Then
            cel.Interior.Color = vbRed
            Me.Cells(cel.Row, "b").Interior.Color = vbRed
        Else
            cel.Interior.ColorIndex = xlColorIndexNone
            Me.Cells(cel.Row, "b").Interior.ColorIndex = xlColorIndexNone
        End If
    Next
    
    Application.EnableEvents = True
    
End Sub

Open in new window



Keep the Change event if the values in S will change by manual entry, and the Calculate event if they will change by formula recalculation.
0
 

Author Comment

by:rsen1
ID: 37723188
Thank you very much
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
how to read all the sheets in excel 12 44
Excel 2016 Not Responding Issues 6 29
Boolean help 6 29
Export Query data to excel file 14 38
A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
: Microsoft Office Collaborate for free and online versions of Microsoft  Word, Excel, Powerpoint, OneNote, Onedrive , Email, Calendar etc. In short we can say that Microsoft office is a suite of servers, applications and services developed by  Micr…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

26 Experts available now in Live!

Get 1:1 Help Now