VBA Adjustment: Apply Border to Group of Cells

[Nanogirl21]

I am using the below VBA code to apply a border around cells. Right now it is only applying the border to columns A-J. What do I need to adjust to make the border expand to column K?

Sub BorderIt()
    Dim Cel As Range, rng As Range, r As Long, a As Variant
    For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set Cel = Cells(r, 1)
        If Cel.MergeCells Then
            Set rng = Cel.MergeArea
            r = Split(Cel.MergeArea.Address, "$")(4) 
        Else
            Set rng = Cel
        End If
        For Each a In Array(rng, rng.Resize(, 10))
            a.BorderAround , Weight:=xlMedium
        Next a
    Next r
 
End Sub

 

[GWteB]

Try changing number 10 into 11:

Sub BorderIt()
    Dim Cel As Range, rng As Range, r As Long, a As Variant
    For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set Cel = Cells(r, 1)
        If Cel.MergeCells Then
            Set rng = Cel.MergeArea
            r = Split(Cel.MergeArea.Address, "$")(4)        'get last row in merged cell
        Else
            Set rng = Cel
        End If
        For Each a In Array(rng, rng.Resize(, 11))
            a.BorderAround , Weight:=xlMedium
        Next a
    Next r
  
End Sub

 

[sykes]

Think this should work - test on a COPY FIRST!

Sub BorderIt()
    Dim Cel As Range, rng As Range, r As Long, a As Variant
    For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set Cel = Cells(r, 1)
        If Cel.MergeCells Then
            Set rng = Cel.MergeArea
            r = Split(Cel.MergeArea.Address, "$")(4) 
        Else
            Set rng = Cel
        End If
        For Each a In Array(rng, rng.Resize(, 11))
            a.BorderAround , Weight:=xlMedium
        Next a
    Next r
 
End Sub

 

[Nanogirl21]

Try changing number 10 into 11:

Sub BorderIt()
    Dim Cel As Range, rng As Range, r As Long, a As Variant
    For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set Cel = Cells(r, 1)
        If Cel.MergeCells Then
            Set rng = Cel.MergeArea
            r = Split(Cel.MergeArea.Address, "$")(4)        'get last row in merged cell
        Else
            Set rng = Cel
        End If
        For Each a In Array(rng, rng.Resize(, 11))
            a.BorderAround , Weight:=xlMedium
        Next a
    Next r
 
End Sub

Think this should work - test on a COPY FIRST!

Sub BorderIt()
    Dim Cel As Range, rng As Range, r As Long, a As Variant
    For r = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set Cel = Cells(r, 1)
        If Cel.MergeCells Then
            Set rng = Cel.MergeArea
            r = Split(Cel.MergeArea.Address, "$")(4)
        Else
            Set rng = Cel
        End If
        For Each a In Array(rng, rng.Resize(, 11))
            a.BorderAround , Weight:=xlMedium
        Next a
    Next r
 
End Sub

Worked perfectly. Thank you.

 

[GWteB]

Glad we could help and thanks for letting us know.

 

[sykes]