VBA to color cells

I am needing to color cells in a range M4 thru Z for as many rows that have values.

For Sheet1
If M4:Z is between 10 and 20 then #CCCCFF
IF M4:Z is between 20 and 30 then #800080
IF M4:Z is between 30 and 40 then #000080

Because of the different colors - conditional formating does not remember the custom color soI can use it on a different sheet.  That is why I am using VBA.

Sub ChangeColor()   ' for sheet 1

    lRow = Range("M" & Rows.Count).End(xlUp).Row
    Set MR = Range("M4:Z" & lRow)
    For Each cell In MR
        If cell.Value = <10 Then cell.Interior.ColorIndex = 10
        If cell.Value = between 10 and 20 Then cell.Interior.ColorIndex = 9
        If cell.Value = between 20 and 30 Then cell.Interior.ColorIndex = 8
    Next
End Sub
Thanks in advance
leezacAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

SteveCommented:
Something like:
Sub ApplyColour()
Dim c As Range, r As Range
Set c = Range("M4:Z" & Range("Z" & Rows.Count).End(xlUp).Row)

Application.ScreenUpdating = False
For Each r In c.Cells
    Select Case r.Value
    Case 0 To 10
        r.Interior.ColorIndex = 10
    Case 10 To 20
        r.Interior.ColorIndex = 9
    Case 20 To 30
        r.Interior.ColorIndex = 8
    End Select
Next r
Application.ScreenUpdating = True
End Sub

Open in new window

0
leezacAuthor Commented:
Yes, but where do I add it is for Sheet1?
0
Swapnil NirmalManager, Audit AnalyticsCommented:
use the below code:

Sub ChangeColor()
Range("M4").Select

Do Until IsEmpty(Selection)
If Selection.Value > 0 And Selection.Value < 11 Then
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End If
If Selection.Value > 10 And Selection.Value < 21 Then
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
End If
If Selection.Value > 20 And Selection.Value < 31 Then
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
End If
Loop
End Sub

Open in new window

0
Fundamentals of JavaScript

Learn the fundamentals of the popular programming language JavaScript so that you can explore the realm of web development.

Swapnil NirmalManager, Audit AnalyticsCommented:
0
SteveCommented:
When would you like the color change to occur? On changes to sheet 1?
You should be able to create a sheet wide conditional format to perform this. I do not see why it would loose the colour etc.
0
leezacAuthor Commented:
I need only for Sheet 1 and Sheet 2

I have other sheets I do not want to format
0
leezacAuthor Commented:
Thanks  n_swapnil but want something simple like The_Barman


The Barman,  but updates wrong sheet....
0
SteveCommented:
The attached workbook has two examples.. the code and Conditional format on sheet 2.

Can you take a look and see what needs adjusting.

I think I am still missing when the macro should fire off.

Option Explicit

Sub ApplyColour()
Dim c As Range, r As Range
Set c = Sheets("Sheet1").Range("M4:Z" & Sheets("Sheet1").Range("Z" & Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
For Each r In c.Cells
    Select Case r.Value
    Case 0 To 10
        r.Interior.ColorIndex = 10
    Case 10 To 20
        r.Interior.ColorIndex = 9
    Case 20 To 30
        r.Interior.ColorIndex = 8
    End Select
Next r
Application.ScreenUpdating = True
End Sub

Open in new window

Custom-Colour.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
leezacAuthor Commented:
I changed Select Case r.NumberFormat from value and seems to work..  I am using Excel 2010

I got an error 13  on Select Case r.value
0
SteveCommented:
I am using 2010.. and r.value works fine so would worry something else is wrong there.

I would not use r.numberformat

how is the sheet looking atm?
How does the CF look?

Could you post the code you have at the moment and how it behaves.

Ta

here is something for the two sheets...
Option Explicit

Sub RunTwoSheets()
Call ApplyColour(Sheets("Sheet1"))
Call ApplyColour(Sheets("Sheet2"))
End Sub
Sub ApplyColour(ws As Worksheet)
Dim c As Range, r As Range
Set c = ws.Range("M4:Z" & ws.Range("Z" & Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
For Each r In c.Cells
    Select Case r.Value
    Case 0 To 10
        r.Interior.ColorIndex = 10
    Case 10 To 20
        r.Interior.ColorIndex = 9
    Case 20 To 30
        r.Interior.ColorIndex = 8
    End Select
Next r
Application.ScreenUpdating = True
End Sub

Open in new window

0
Harry LeeCommented:
leezac,

Is there any reason why you would like to do this with VBA? I personally thinks conditional format would be the best solution for the following reason.

1) Any action done by VBA cannot be undone. If something goes wrong, you have to fix it manually.
2) The color code in VBA is pretty much hard coded. Unlike conditional format, there is a nice interface for you to change the format in the future if you ever decided to change the colors.
3) In case you change the sheet names in the future, the VBA will stop working. In fact, most changes on the sheet structure would stop the VBA from working.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.