VBA code to add thick border around group of rows containing a bolded cell.

[Curtisyoung78]

Once again I need your help. I am looking for a code to find rows that have atleast one bolded cell then place a thick border around that row and if there are consecutive rows containing bolded cells add a thick border around group of cells. the range is A12 to column R and the bottom row used. I am trying to frame the groups of rows containing bolded cells wether its just one or multiple rows consecutively, the one row to have its own border and a group of multiple consecutive rows to get another border.

example. Row 13 has a bolded cell (col range A to R) and also rows 16 through (and including) row 24 all contain atleast one bolded cell each, then bold around A13:R13 (thick border around row and not all cells)and also a thick border around A16:R24 (one thick border around group of rows and not around individual rows or cells).

Thanks for your help in advance.

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG01Aug49
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]For[/COLOR] Ac = 0 To 18
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, Ac).Font.Bold [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Cells(Dn.Row, 1).Resize(, 18)
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Cells(Dn.Row, 1).Resize(, 18))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Exit[/COLOR] For
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] nRng.Areas
    Dn.BorderAround ColorIndex:=1, Weight:=xlThick
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Rick Rothstein]

Here is another macro that you can try...

[table="width: 500"]
[tr]
	[td]Sub PutBordersAroundCells()
  Dim R As Long, UnusedColumn As Long, LastRow As Long, Ar As Range
  UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  For R = 12 To LastRow
    If Rows(R).Font.Bold = True Or IsNull(Rows(R).Font.Bold) Then Cells(R, UnusedColumn).Value = "X"
  Next
  On Error GoTo NoBoldCells
  For Each Ar In Intersect(Columns("A:R"), Columns(UnusedColumn).SpecialCells(xlConstants).EntireRow).Areas
    Ar.BorderAround xlContinuous, xlThick
  Next
NoBoldCells:
  Columns(UnusedColumn).Clear
End Sub[/td]
[/tr]
[/table]

 

[Curtisyoung78]

Worked perfectly, exactly what I was looking for, thanks very much MikeG.

Try this:-

[COLOR=Navy]Sub[/COLOR] MG01Aug49
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
[COLOR=Navy]For[/COLOR] Ac = 0 To 18
    [COLOR=Navy]If[/COLOR] Dn.Offset(, Ac).Font.Bold [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]If[/COLOR] nRng [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]Set[/COLOR] nRng = Cells(Dn.Row, 1).Resize(, 18)
        [COLOR=Navy]Else[/COLOR]
            [COLOR=Navy]Set[/COLOR] nRng = Union(nRng, Cells(Dn.Row, 1).Resize(, 18))
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Exit[/COLOR] For
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] nRng.Areas
    Dn.BorderAround ColorIndex:=1, Weight:=xlThick
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[MickG]

You're welcome