Formatting alternate row colours when some rows are merged in Column A

[TheRedCardinal]

I have a variation on the below code which colours my rows different shades of blue.

Sub StripeyPresentation()

Dim Rng As Range
Set Rng = Selection

With Rng.FormatConditions.Add(Type:=xlExpression, Formula1:="=MOD(ROW(),2)=0")
    .Interior.Color = RGB(208, 216, 232)
    .Borders.LineStyle = xlContinuous
    .Borders.ThemeColor = 1
    .Borders.Weight = xlThin
End With

With Rng.FormatConditions.Add(Type:=xlExpression, Formula1:="=MOD(ROW(),2)=1")

    .Interior.Color = RGB(233, 237, 244)
    .Borders.LineStyle = xlContinuous
    .Borders.ThemeColor = 1
    .Borders.Weight = xlThin

End With

End Sub

My problem is some of my cells in the first column are merged, the pattern is not fixed and nor is the number of merged cells. But I want all of the subsequent columns to be the same colour as the cell in column A.

Here is a picture:

So row 1 is good.

Row A2:A4 are merged and one colour, but B2:E4 have alternate colours.

Is my request even possible?

 

[sandy666]

like this?

but it MUST be a vba?

 

[Peter_SSs]

Try this Conditional Formatting (converted to vba if required)

A_MrExcel.xlsm
	A	B	C	D	E
1	1	data	data	data	data
2	2	data	data	data	data
3		data	data	data	data
4		data	data	data	data
5	3	data	data	data	data
6	4	data	data	data	data
7	5	data	data	data	data
8	8	data	data	data	data
9		data	data	data	data
10		data	data	data	data
11		data	data	data	data
12		data	data	data	data
Shade rows

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A1:E12	Expression	=MOD(COUNTA($A$1:$A1),2)=0	text	YES
A1:E12	Expression	=MOD(COUNTA($A$1:$A1),2)=1	text	YES

 

[TheRedCardinal]

like this?
View attachment 5400
but it MUST be a vba?

Not quite - you have column A right but B and C should always be the same as A.

I think it needs to be VBA because the prior sheet is deleted and a new one created and not sure conditional formatting would survive that?

 

[TheRedCardinal]

Try this Conditional Formatting (converted to vba if required)

A_MrExcel.xlsm
	A	B	C	D	E
1	1	data	data	data	data
2	2	data	data	data	data
3		data	data	data	data
4		data	data	data	data
5	3	data	data	data	data
6	4	data	data	data	data
7	5	data	data	data	data
8	8	data	data	data	data
9		data	data	data	data
10		data	data	data	data
11		data	data	data	data
12		data	data	data	data
Shade rows

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A1:E12	Expression	=MOD(COUNTA($A$1:$A1),2)=0	text	YES
A1:E12	Expression	=MOD(COUNTA($A$1:$A1),2)=1	text	YES

That looks right to me thanks!

I'll have a go at converting it to VBA!

 

[Peter_SSs]

Could be something like this.

Sub StripeyPresentation_v2()
  Dim Rng As Range
  
  Set Rng = Range("A1").CurrentRegion
  With Rng
    .FormatConditions.Delete
    With .FormatConditions.Add(Type:=xlExpression, Formula1:="=MOD(COUNTA(" & Rng.Cells(1).Address & ":" & Rng.Cells(1).Address(0, 1) & "),2)=0")
      .Interior.Color = RGB(208, 216, 232)
      .Borders.LineStyle = xlContinuous
      .Borders.ThemeColor = 1
      .Borders.Weight = xlThin
    End With
    With .FormatConditions.Add(Type:=xlExpression, Formula1:="=MOD(COUNTA(" & Rng.Cells(1).Address & ":" & Rng.Cells(1).Address(0, 1) & "),2)=1")
      .Interior.Color = RGB(233, 237, 244)
      .Borders.LineStyle = xlContinuous
      .Borders.ThemeColor = 1
      .Borders.Weight = xlThin
    End With
  End With
End Sub

 

[sandy666]

I think it needs to be VBA

sure, that was just a question
thanks

 

[Rick Rothstein]

If you are looking for a straight (direct) VBA macro that colors the cell only when you run it...

Sub AlternateColorsWithMergeAreas()
  Dim Rw As Long, Cnt As Long, Colr As Long
  With Range("A1").CurrentRegion
    .EntireColumn.Interior.Color = xlNone
    .EntireColumn.Borders.LineStyle = xlNone
    .Columns.Borders(xlInsideVertical).Weight = xlThin
    .Columns.Borders(xlInsideHorizontal).Weight = xlThin
    .BorderAround , xlThin
    Colr = RGB(208, 216, 232)
    Do
      Colr = RGB(208, 216, 232) + RGB(233, 237, 244) - Colr
      Cnt = Cells(Rw + 1, "A").MergeArea.Rows.Count
      Cells(Rw + 1, "A").Resize(Cnt, .Columns.Count).Interior.Color = Colr
      Rw = Rw + Cnt
    Loop While Rw < .Rows.Count
  End With
End Sub