Macro to produce Thick Border Box

I would like a think border box to be automatically inserted where there are values to the right of text which is in Col A and the text is in bold

For Eg if A15 "Net Profit" is in in Bold and B15, C16, D17 etc has values then a thick Border must be inserted around the values

If the text is in Bold and the first row next to it is blank, then this must be ignored i.e no thick black box where there are no values to the right is text that is in bold

Your assistance in this regard is most appreciated

Did you use the macrorecorder ?

Thanks for the reply

I did use a macro recorder, but not sure how to have the thick Border Box aroond the values in the same row where the text in Col, A is highlighted
I have attempted to write code but need help in completing this

Will most propably have to have this as a Private Sub to be copied in the code for the applicable sheet

Code:

---

Sub Borders ()

If Text.bold = True
Then  ?????

With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous


Else
Exit Sub
next

End with
End Sub

---

Your assistance in resolving this is most appreciated

try this:

Code:

---

Option Explicit

Sub bold()
Dim lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
Dim c As Range
Dim rng As Range
Set rng = Range("A1:A" & lr)

For Each c In rng
If c.Font.bold = True And Len(c.Offset(0, 1)) > 0 Then
    c.Resize(, 5).Select
    Selection.BorderAround Weight:=xlThick
End If
Next c
MsgBox "complete"
End Sub

---

Thanks for the help, much appreciated

Hi Alan

Code works perfectly where there are several columns next to Col A where the text is in bold

I have another sheet where there is only one value next to the text which is in bold and I get type mismatch and the following code is highlighted

Code:

---

If c.Font.bold = True And Len(c.Offset(0, 1)) > 0 Then

---

I have amended your code to produce a thick border box where there is is one value to the right of the bold text

Kindly test & amend

Code:

---

Sub Thick_Border_Bank()
Sheets("Man Accounts Bank").Select
Dim lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
Dim c As Range
Dim rng As Range
Set rng = Range("A1:A" & lr)

For Each c In rng
If c.Font.bold = True And Len(c.Offset(0, 1)) > 0 Then
    c.Offset(, 1).Select
    Selection.BorderAround Weight:=xlThick
End If
Next c
MsgBox "complete"
End Sub

---

Tested. Worked without issue. Had to change the sheet name to reflect my sheet name, but other than that, I used the code provided without any problems. If you would like further help, suggest you upload your problem workbook/worksheet for analysis.

Hi Alan

I added "On Error resume next" to mey code and it now works

There is no need to Select the cells before you put the border around them, and as you only use some of those values once you don't need to assign them to variables and the code will be much shorter:

Code:

---

Sub Thick_Border_Bank()
Sheets("Man Accounts Bank").Select
Dim c As Range
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    If c.Font.Bold = True And c.Offset(, 1) <> "" Then c.Offset(, 1).BorderAround , xlThick
Next c
MsgBox "complete"
End Sub

---

There's not even need to select the sheet.

Code:

---

Sub Thick_Border_Bank()
    Dim c As Range
    With Sheets("Man Accounts Bank")
        For Each c In .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
            If c.Font.Bold And c.Offset(, 1) <> vbNullString Then c.Offset(, 1).BorderAround , xlThick
        Next c
    End With
End Sub

---

Thanks for help, much appreciated

I have added the following code to clear the borders at the beginning of the code.

It would be appreciated if you would streamline this

Code:

---

With Range("A:D")

 .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
  .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone

End With

---

Code:

---

    Dim b As Variant
    For Each b In Array(xlDiagonalDown, xlDiagonalUp, xlEdgeLeft, xlEdgeTop, _
            xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
        Range("A:D").Borders(b).LineStyle = xlNone
    Next

---

Thanks for the help, much appreciated

If you don't actually need the diagonals:

Code:

---

Range("A:D").Borders.LineStyle = xlNone

---

Thanks Scott, The diagonals, slow down the process tremendously

Have tested code and is super fast