Do 2-font colour according (in the area) as per list parameters

[motilulla]

Hello,</SPAN></SPAN>

I got a list in the column M that has a Start row number & in the column N that has an End row number </SPAN></SPAN>

I need to do font colour in the area columns C:J as per row numbers are listed in column M:N </SPAN></SPAN>

For example </SPAN></SPAN>
C6:J15 = font Red</SPAN></SPAN>
C16:J24 = font Blue</SPAN></SPAN>
C25:J33 = font Red</SPAN></SPAN>
C34:J44 = font Blue</SPAN></SPAN>
C45:J51 = font Red........ </SPAN>and so on as per list </SPAN></SPAN>
Thank you all</SPAN></SPAN>

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1
2
3
4
5													Start Row Num	End Row Num
6			A	A	A	A	A	A	A	A			6	15
7			A	A	A	A	A	A	A	A			16	24
8			A	A	A	A	A	A	A	A			25	33
9			A	A	A	A	A	A	A	A			34	44
10			A	A	A	A	A	A	A	A			45	51
11			A	A	A	A	A	A	A	A			52	100
12			A	A	A	A	A	A	A	A			101	122
13			A	A	A	A	A	A	A	A			123	167
14			A	A	A	A	A	A	A	A			168	190
15			A	A	A	A	A	A	A	A			191	205
16			A	A	A	A	A	A	A	A			206	290
17			A	A	A	A	A	A	A	A			291	455
18			A	A	A	A	A	A	A	A			456	570
19			A	A	A	A	A	A	A	A
20			A	A	A	A	A	A	A	A
21			A	A	A	A	A	A	A	A
22			A	A	A	A	A	A	A	A
23			A	A	A	A	A	A	A	A
24			A	A	A	A	A	A	A	A
25			A	A	A	A	A	A	A	A
26			A	A	A	A	A	A	A	A
27			A	A	A	A	A	A	A	A
28			A	A	A	A	A	A	A	A
29			A	A	A	A	A	A	A	A
30			A	A	A	A	A	A	A	A
31			A	A	A	A	A	A	A	A
32			A	A	A	A	A	A	A	A
33			A	A	A	A	A	A	A	A
34			A	A	A	A	A	A	A	A
35			A	A	A	A	A	A	A	A
36			A	A	A	A	A	A	A	A
37			A	A	A	A	A	A	A	A
38			A	A	A	A	A	A	A	A
39			A	A	A	A	A	A	A	A
40			A	A	A	A	A	A	A	A
41			A	A	A	A	A	A	A	A
42			A	A	A	A	A	A	A	A
43			A	A	A	A	A	A	A	A
44			A	A	A	A	A	A	A	A
45			A	A	A	A	A	A	A	A
46			A	A	A	A	A	A	A	A
47			A	A	A	A	A	A	A	A
48			A	A	A	A	A	A	A	A
49			A	A	A	A	A	A	A	A
50			A	A	A	A	A	A	A	A
51			A	A	A	A	A	A	A	A
52
Sheet2

Excel 2000</SPAN></SPAN>
Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>

 

[mrshl9898]

How's this?

Sub applycolortorange()


Dim rownum As Long
Dim myrange As Range
Dim mystr As String
Dim myColor As Long


rownum = 6
Sheets("Sheet2").Select


Do Until Cells(rownum, 13).Value = ""
mystr = "C" & Cells(rownum, 13).Value & ":" & "J" & Sheets("Sheet2").Cells(rownum, 14).Value
Set myrange = Range(mystr)
myColor = Cells(rownum, 13).Font.ColorIndex
myrange.Font.ColorIndex = myColor
rownum = rownum + 1
Loop


End Sub

 

[motilulla]

How's this?

Sub applycolortorange()


Dim rownum As Long
Dim myrange As Range
Dim mystr As String
Dim myColor As Long


rownum = 6
Sheets("Sheet2").Select


Do Until Cells(rownum, 13).Value = ""
mystr = "C" & Cells(rownum, 13).Value & ":" & "J" & Sheets("Sheet2").Cells(rownum, 14).Value
Set myrange = Range(mystr)
myColor = Cells(rownum, 13).Font.ColorIndex
myrange.Font.ColorIndex = myColor
rownum = rownum + 1
Loop


End Sub

Thank you mrshl9898, it worked perfect</SPAN></SPAN>

Have a nice day</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti </SPAN></SPAN>

 

[motilulla]

After using the macro I found it is colouring font according the row numbers colours are filled in the range M:N, really that I tried to show just as example originally font colour in the range M:N are black </SPAN></SPAN>

So is there any alternate solution to fill 2 different font colours without filling the colours in rang M:N</SPAN></SPAN>

Thank you</SPAN></SPAN>

Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>

 

[Peter_SSs]

Try this

Sub Do_Font_Colour()
  Dim c As Range
  Dim FontCol As Long
  
  FontCol = vbBlue
  With Range("C:J")
    For Each c In Range("M6", Range("M6").End(xlDown))
      FontCol = IIf(FontCol = vbBlue, vbRed, vbBlue)
      .Rows(c.Value & ":" & c.Offset(, 1).Value).Font.Color = FontCol
    Next c
  End With
End Sub

 

[motilulla]

Try this

Sub Do_Font_Colour()[/QUOTE]
[COLOR=#000000]Peter, thank you very much. It worked as appeal[/COLOR]</SPAN></SPAN>[COLOR=#000000]

Kind Regards,[/COLOR]</SPAN></SPAN>[COLOR=#000000]
Moti :)[/COLOR]</SPAN></SPAN>[COLOR=#000000]
[/COLOR]

 

[Peter_SSs]

Peter, thank you very much. It worked as appeal</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti </SPAN></SPAN>

You're welcome. In fact it could have been slightly simpler.

Sub Do_Font_Colour()
  Dim c As Range
  Dim FontCol As Long

  With Range("C:J")
    For Each c In Range("M6", Range("M6").End(xlDown))
      FontCol = IIf(FontCol = vbRed, vbBlue, vbRed)
      .Rows(c.Value & ":" & c.Offset(, 1).Value).Font.Color = FontCol
    Next c
  End With
End Sub

 

[motilulla]

You're welcome. In fact it could have been slightly simpler.

Thank you Peter
Regards Moti