How to get around Excels 3 Criteria Limit in Conditional Formatting.

[kmtech]

I have a spreadsheet named “Log” with data in range A11:X1200 that I would like to change each raw's background color based on the value in column Y for that raw. Column Y values are set between 1 and 6. Does anyone have suggestions for an auto run script to do so that does not bug down for this size sheet. The sheet does many calculations.

Thanks,
KM

[Guido Geurs]

This is a macro for coloring the rows in function of the value in the Y col.(see also attachment)

Public Sub Color_Rows()
Dim ACTIVEROW As Integer
Dim ACTIVECELLVALUE As Integer
   Range("Y1").Activate 'go to first cell
   Do While ActiveCell.Value <> ""
      ACTIVEROW = ActiveCell.Row
      ACTIVECELLVALUE = ActiveCell.Value
      Rows(ACTIVEROW).Select  'select row
      With Selection.Interior
         Select Case ACTIVECELLVALUE
         Case 1
            .ColorIndex = 2
         Case 2
            .ColorIndex = 3
         Case 3
            .ColorIndex = 4
         Case 4
            .ColorIndex = 5
         Case 5
            .ColorIndex = 6
         Case 6
            .ColorIndex = 7
         End Select
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
      End With
      Range("Y" & ACTIVEROW).Activate  'go back to 1 cell in col Y
      ActiveCell.Offset(1, 0).Activate 'activate cell in next row
   Loop
End Sub

If this macro don't does the work, is it possible to attach an example sheet so we can do some tests ?

[kmtech]

How to get arround type mismatch?

Yhanks for the help.
I downloaded the sample spreadsheet and macro which worked ad designed.

I had few obsticle when applied to my spreadsheet. In line cell Y10, I have text not an integer between 1 - 6; some cells are empty since not all rows are ready to assign a value between 1-6; and I was hopping to stop the highlighting at column Y. I was able to work a fix for the text and blamk cell problems (not the best, but it worked), however, I could not get arround the total row highlighting. Here is what I did:

' Macro to color Rows based on the value in column Y
Public Sub Color_Rows()
Dim ACTIVEROW As Integer
Dim ACTIVECELLVALUE As Integer

Range("Y1").Act ivate 'go to first cell Rows 1
ACTIVEROW = ActiveCell.Row
Do While ACTIVEROW < 7 ' To Row 7

ACTIVEROW = ActiveCell.Row
ACTIVECELLVALUE = ActiveCell.Valu e
Rows(ACTIVEROW) .Select 'select row
With Selection.Inter ior
Select Case ACTIVECELLVALUE
Case 1
.ColorIndex = 40
Case 2
.ColorIndex = 34
Case 3
.ColorIndex = 36
Case 4
.ColorIndex = 15
Case 5
.ColorIndex = 37
Case 6
.ColorIndex = 45
Case 7
.ColorIndex = 41

Case Is <> 1 - 6
.ColorIndex = 2
End Select

.Pattern = xlSolid
.PatternColorIn dex = xlAutomatic
End With
Range("Y" & ACTIVEROW).Acti vate 'go back to 1 cell in col Y
ActiveCell.Offs et(1, 0).Activate 'activate cell in next row

Loop


Range("Y13").Ac tivate 'go to first cell Row 13
ACTIVEROW = ActiveCell.Row
Do While ACTIVEROW < 300 ' To Row 300


ACTIVEROW = ActiveCell.Row
ACTIVECELLVALUE = ActiveCell.Valu e
Rows(ACTIVEROW) .Select 'select row
With Selection.Inter ior
Select Case ACTIVECELLVALUE
Case 1
.ColorIndex = 40
Case 2
.ColorIndex = 34
Case 3
.ColorIndex = 36
Case 4
.ColorIndex = 15
Case 5
.ColorIndex = 37
Case 6
.ColorIndex = 45
Case 7
.ColorIndex = 41

Case Is <> 1 - 6
.ColorIndex = 2
End Select
.Pattern = xlSolid
.PatternColorIn dex = xlAutomatic
End With
Range("Y" & ACTIVEROW).Acti vate 'go back to 1 cell in col Y
ActiveCell.Offs et(1, 0).Activate 'activate cell in next row

Loop
Range("A12").Se lect
End Sub

Thanks again for your help.

[Guido Geurs]

Is there a column with no blanc's in the middle?
You can take This column as reference to loop through and pick the value from column Y with "offset" like this:

Lets take column "D" as a column with always a value through the hole sheet to the end of the data!
The offset (same row = 0) and from D to Y = 21 columns

' Macro to color Rows based on the value in column Y
Public Sub Color_Rows()
Dim ACTIVEROW As Integer
Dim ACTIVECELLVALUE As Integer
   Range("D1").Activate 'go to first cell column D
   Do While ActiveCell.Value <> "" ' run to end
      ACTIVEROW = ActiveCell.Row
      ACTIVECELLVALUE = ActiveCell.Offset(0, 21).Value
      Rows(ACTIVEROW).Select 'select row
      With Selection.Interior
         Select Case ACTIVECELLVALUE
         Case 1
            .ColorIndex = 40
         Case 2
            .ColorIndex = 34
         Case 3
            .ColorIndex = 36
         Case 4
            .ColorIndex = 15
         Case 5
            .ColorIndex = 37
         Case 6
            .ColorIndex = 45
         Case 7
            .ColorIndex = 41
         Case Else
            .ColorIndex = 2
         End Select
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
      End With
      Range("D" & ACTIVEROW).Activate 'go back to 1 cell in col D
      ActiveCell.Offset(1, 0).Activate 'activate cell in next row
   Loop
   Range("A12").Select
End Sub

[kmtech]

mismatch type error &quot;13&quo t;.

Thanks again for the help.

I used Col "A" as the Col w/o blank's It changes the data from text to Nos. Therefore, I am getting a mismatch type error "13".

I reformatted col A as text, it did not solve the problem.

The data in the table is updated by an Access database report. Therefore, I cannot create a dummy col.

See attached test file.

[Guido Geurs]

In the sheet there are different zones:
1 - 7 = A and B are merged, so the offset is 24-1 =23
11 = is a filter so you can't use offset
12 - ... = A and B not merged, so offset = 24

I have added the code to filter out these zones (see also attachment)=

      Select Case ActiveCell.Row
      Case Is > 11
         OffsetValue = 24
      Case Is < 8
         OffsetValue = 23
      End Select
      ACTIVEROW = ActiveCell.Row
      ACTIVECELLVALUE = ActiveCell.Offset(0, OffsetValue).Value

[kmtech]

Good job

Thanks ggeu, that does it. You have been a great help.