Mark consecutive Non-Blank Cells

[rit_netsys]

Hello,
I need to mark consecutive more than 5 Non-Blank cells in excel like given below. It will be good if this can be done in VBA Macro.

A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD
2	5		3	4	3	3	3	4		3	3	2		3	3	3	3	3	3	3			4	4		4		4
1	2	3	4	5	6	5	7		7		8		8		7	6		5		4	3	4			6		6		6
	2	3	4	5	6	7	7	8			6	7	6	7	6	8	6		6		6			6			6		6

<tbody>
</tbody>

Need help to achieve this.

 

[MickG]

Try this, for data starting row 1 :-

[COLOR=navy]Sub[/COLOR] MG10Apr06
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, R [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        Lst = Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
            [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Dn.Resize(, Lst).SpecialCells(xlCellTypeConstants).Areas
                [COLOR=navy]If[/COLOR] R.Count > 5 [COLOR=navy]Then[/COLOR] R.Font.Color = vbRed
            [COLOR=navy]Next[/COLOR] R
    [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[Fluff]

How about

Sub FlagCells()
   Dim Rng As Range
   Dim i As Long
   For i = 1 To ActiveSheet.UsedRange.Rows.Count
      For Each Rng In Rows(i).SpecialCells(xlConstants).Areas
         If Rng.Count > 5 Then Rng.Font.Color = vbRed
      Next Rng
   Next i
End Sub

 

[rit_netsys]

Many thanks.. Its working fine

Try this, for data starting row 1 :-

[COLOR=navy]Sub[/COLOR] MG10Apr06
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, R [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        Lst = Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
            [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Dn.Resize(, Lst).SpecialCells(xlCellTypeConstants).Areas
                [COLOR=navy]If[/COLOR] R.Count > 5 [COLOR=navy]Then[/COLOR] R.Font.Color = vbRed
            [COLOR=navy]Next[/COLOR] R
    [COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[rit_netsys]

Thanks.. this is also working

How about

Sub FlagCells()
   Dim Rng As Range
   Dim i As Long
   For i = 1 To ActiveSheet.UsedRange.Rows.Count
      For Each Rng In Rows(i).SpecialCells(xlConstants).Areas
         If Rng.Count > 5 Then Rng.Font.Color = vbRed
      Next Rng
   Next i
End Sub

 

[Fluff]

Glad we could help & thanks for the feedback

 

[MickG]

You're welcome