Conditional formatting for groups of different size

methody

Well-known Member
Joined
Jun 17, 2002
Messages
845
Hi
I have a large grid with rows of 1's or 0's. Some of the 1's are single (ie surrounded by 0's -010) some are in groups of 2 (ie 2 1's beside each other - 0110) some are in groups of 3 etc 01110. up to groups of 8.

I wan to use conditional formatting so that the singles are blue, the doubles are red, the triples are green etc.

I thought it would be straightforward but it doesn't seem to be. I can manage the first 1 in each group but when you fill across problems occur. I tried use ifs, ands and or but to no avail.

any ideas
thanks
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,732
Office Version
  1. 2010
Platform
  1. Windows
I think the only way you can do that is by using vba, this code should do what you have asked for, I have only coded the case 1 to 3 but you can easily add more case and color subs
VBA Code:
Sub test()
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(LastRow, LastCol))
For i = 2 To LastRow
' initialise column counter
ct = 0 ' note This relies on there only being 1 or 0 in column A
For j = 1 To LastCol
   If inarr(i, j) = 0 Then
          If ct > 0 Then
      nt = j - ct
      Select Case ct
      Case 1
       Call blue(Range(Cells(i, nt), Cells(i, j - 1)))
      Case 2
      Call red(Range(Cells(i, nt), Cells(i, j - 1)))
      Case 3
      Call green(Range(Cells(i, nt), Cells(i, j - 1)))
      End Select
     End If
     ct = 0
   Else
    ct = ct + 1  ' increment to 1 counter
   End If
Next j
' cater for the last coloumn
     If ct > 0 Then
      nt = j - ct
      Select Case ct
      Case 1
       Call blue(Range(Cells(i, nt), Cells(i, j - 1)))
      Case 2
      Call red(Range(Cells(i, nt), Cells(i, j - 1)))
      Case 3
      Call green(Range(Cells(i, nt), Cells(i, j - 1)))
      End Select
     End If

Next i

     
End Sub
Sub blue(rr As Range)
'
' blue Macro
'
    With rr.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
Sub red(rr As Range)
'
' red Macro
'

'
    With rr.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("J9:L9").Select
End Sub
Sub green(rr As Range)
'
' green Macro
'

'
    With rr.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub
 

StephenCrump

MrExcel MVP
Joined
Sep 18, 2013
Messages
4,119
Office Version
  1. 365
Platform
  1. Windows
Perhaps like this:

ABCDEFGHIJKLMNOPQRSTUVWXYZAA
1
200111100111011110101110010
301001110111010001000000010
401100001000000011111000001
511001010001011110111010110
600010100010100011001111011
710100111100001111001001101
801001110110101000100011101
900011100111101010100111001
1010100001011001001001011000
1110001010011011010000111000
1201011011110000011110111010
1301111110111000111011010101
1400101100010100110111010000
1511111000011111001010001001
1610011111011100000111111000
1711111100111000011000110001
1810100001000000011110111001
1901000100000111011111101000
2010100000010010000001100000
2110110100101101111011101101
Sheet1
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B2:AA21Expression=IF(B2=1,MATCH(0,C2:$AB2,)+COLUMN()-1-MAX(($A2:A2=0)*COLUMN($A2:A2)),0)=1textNO
B2:AA21Expression=IF(B2=1,MATCH(0,C2:$AB2,)+COLUMN()-1-MAX(($A2:A2=0)*COLUMN($A2:A2)),0)=2textNO
B2:AA21Expression=IF(B2=1,MATCH(0,C2:$AB2,)+COLUMN()-1-MAX(($A2:A2=0)*COLUMN($A2:A2)),0)=3textNO
B2:AA21Expression=IF(B2=1,MATCH(0,C2:$AB2,)+COLUMN()-1-MAX(($A2:A2=0)*COLUMN($A2:A2)),0)>=4textNO
 

StephenCrump

MrExcel MVP
Joined
Sep 18, 2013
Messages
4,119
Office Version
  1. 365
Platform
  1. Windows
Oops. missed the last column. Change the rules to:

=IF(B2=1,MATCH(0,SIGN(B2:$AB2),)+COLUMN()-2-MAX(($A2:A2=0)*COLUMN($A2:A2)),0)=1 etc
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,127,529
Messages
5,625,351
Members
416,096
Latest member
forevans

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
Top