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.

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[TD]M[/TD]
[TD]N[/TD]
[TD]O[/TD]
[TD]P[/TD]
[TD]Q[/TD]
[TD]R[/TD]
[TD]S[/TD]
[TD]T[/TD]
[TD]U[/TD]
[TD]V[/TD]
[TD]W[/TD]
[TD]X[/TD]
[TD]Y[/TD]
[TD]Z[/TD]
[TD]AA[/TD]
[TD]AB[/TD]
[TD]AC[/TD]
[TD]AD[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]5[/TD]
[TD][/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD][/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]2[/TD]
[TD][/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[TD]4[/TD]
[TD]4[/TD]
[TD][/TD]
[TD]4[/TD]
[TD][/TD]
[TD]4[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]5[/TD]
[TD]7[/TD]
[TD][/TD]
[TD]7[/TD]
[TD][/TD]
[TD]8[/TD]
[TD][/TD]
[TD]8[/TD]
[TD][/TD]
[TD]7[/TD]
[TD]6[/TD]
[TD][/TD]
[TD]5[/TD]
[TD][/TD]
[TD]4[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD][/TD]
[TD][/TD]
[TD]6[/TD]
[TD][/TD]
[TD]6[/TD]
[TD][/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]7[/TD]
[TD]8[/TD]
[TD][/TD]
[TD][/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]6[/TD]
[TD]7[/TD]
[TD]6[/TD]
[TD]8[/TD]
[TD]6[/TD]
[TD][/TD]
[TD]6[/TD]
[TD][/TD]
[TD]6[/TD]
[TD][/TD]
[TD][/TD]
[TD]6[/TD]
[TD][/TD]
[TD][/TD]
[TD]6[/TD]
[TD][/TD]
[TD]6[/TD]
[/TR]
</tbody>[/TABLE]

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