color Macro on multiple sheets

[seanc]

I am trying to setup a macro to run on all my worksheets(9) in a book.

I just need it to un through every cell and
If active cell equals text MEDIUM then interior color equals red.
Then there will be a quite a few elseifs after that.

Thanks



Sent from my SCH-I535 using Tapatalk 2

[Ken Puls]

This will work:

Sub ColorMe()Dim ws As Worksheet
Dim cl As Range


For Each ws In ActiveWorkbook.Worksheets
    For Each cl In ws.UsedRange
        Select Case cl.Value
            Case Is = "MEDIUM"
                cl.Interior.ColorIndex = 3
            Case Else
                'Keep adding "Case Is = " statements for each "ElseIf"
                'This section is what to do if the cell does not meet
                'your criteria
        End Select
    Next cl
Next ws
End Sub

Depending on how many worksheets and cells you have though, this may take a long time to run.

Curious, why use a macro instead of using conditional formatting? It's built for this task and then only works on the cells that are of interest...

[seanc]

I have 9 work sheets and 10 colors.

I have a master list worksheet that the other 8 are linked to.

Basically it's. 8 sheets showing the data off of 1.

Is there a way I can set all the colors for each cell in the master and the linked cells show the same color?

Sent from my SCH-I535 using Tapatalk 2

[seanc]

What you showed me actually works fine.

But do you know a way to set it

if say I have cell that include certain words to change the color.

Say anything with IPT In the text will turn green



Sent from my SCH-I535 using Tapatalk 2

[Bob Phillips]

Try something like this in ThisWorkbook code module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)    
    Select Case True
        Case Target.Value Like "*MEDIUM*"
            Target.Interior.ColorIndex = 3
        Case Else
            'Keep adding "Case Is = " statements for each "ElseIf"
            'This section is what to do if the cell does not meet
            'your criteria
    End Select
End Sub