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

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
Office Version
  1. 2010
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
ABCDEFGHIJKLMNOP
1
2
3
4
5Start Row NumEnd Row Num
6AAAAAAAA615
7AAAAAAAA1624
8AAAAAAAA2533
9AAAAAAAA3444
10AAAAAAAA4551
11AAAAAAAA52100
12AAAAAAAA101122
13AAAAAAAA123167
14AAAAAAAA168190
15AAAAAAAA191205
16AAAAAAAA206290
17AAAAAAAA291455
18AAAAAAAA456570
19AAAAAAAA
20AAAAAAAA
21AAAAAAAA
22AAAAAAAA
23AAAAAAAA
24AAAAAAAA
25AAAAAAAA
26AAAAAAAA
27AAAAAAAA
28AAAAAAAA
29AAAAAAAA
30AAAAAAAA
31AAAAAAAA
32AAAAAAAA
33AAAAAAAA
34AAAAAAAA
35AAAAAAAA
36AAAAAAAA
37AAAAAAAA
38AAAAAAAA
39AAAAAAAA
40AAAAAAAA
41AAAAAAAA
42AAAAAAAA
43AAAAAAAA
44AAAAAAAA
45AAAAAAAA
46AAAAAAAA
47AAAAAAAA
48AAAAAAAA
49AAAAAAAA
50AAAAAAAA
51AAAAAAAA
52
Sheet2


Excel 2000</SPAN></SPAN>
Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Last edited:

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
How's this?

Code:
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
 
Last edited:
Upvote 0
How's this?

Code:
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>
 
Upvote 0
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>
 
Upvote 0
Try this
Code:
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
 
Last edited:
Upvote 0
Try this
Code:
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]
 
Upvote 0
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.
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

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
Back
Top