VBA for thick cell border

[MrzSanchez]

I havea column that need to apply thick border around individual cell if cell fromanother column (same row) meets criteria. Column K row 6 and below is thecolumn need to apply thick borer to. Column BK row 6 and below is the column itneeds to check if it contains specific content. example: if cell BK17 = 3 thenapply thick border around cell K17 only, and so on.


Icannot do this with Conditional Formatting because thick border is arequirement.

I'musing the following code but it boxes all cell in K column range not only thecells where the respective BK cell = 3.

Sub Test()
    Dim LastRow As Long
    Dim r As Long
    With ActiveSheet
        LastRow =.Range("BK6").End(xlDown).Row
        For r = 6 To LastRow
            If .Range("BK" &r).Value = "3" Then
                With .Range("K6:K"& LastRow).Borders(xlTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThick
                    .ColorIndex = xlAutomatic
                End With
                With .Range("K6:K"& LastRow).Borders(xlLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThick
                    .ColorIndex = xlAutomatic
                End With
                With .Range("K6:K"& LastRow).Borders(xlRight)
                     .LineStyle = xlContinuous
                     .Weight = xlThick
                     .ColorIndex = xlAutomatic
                End With
                With .Range("K6:K"& LastRow).Borders(xlBottom)
                     .LineStyle = xlContinuous
                     .Weight = xlThick
                     .ColorIndex = xlAutomatic
                End With
                With .Range("K6:K"& LastRow).Borders(xlTop)
                     .LineStyle = xlContinuous
                     .Weight = xlThick
                     .ColorIndex = xlAutomatic
                 End With

            End If
        Next r
    End With
End Sub

 

[Fluff]

Try

Sub Test()
    Dim LastRow As Long
    Dim r As Long
    With ActiveSheet
        LastRow = .Range("BK6").End(xlDown).Row
        For r = 6 To LastRow
            If .Range("BK" & r).Value = "3" Then
               With .Range("K" & r).Borders
                    .LineStyle = xlContinuous
                    .Weight = xlThick
                    .ColorIndex = xlAutomatic
                End With
            End If
        Next r
    End With
End Sub

If the BK column is numbers rather than text remove the quotes from the ="3"

 

[Joe4]

That is because you are looping through each row in column BK in your code, but then applying the thick border to the entire range, instead of just that one cell!
So, if any one cell is "3", the whole range will be get that formatting.

You should change all references of:

.Range("K6:K" & LastRow)

to

.Range("K" & r )

 

[MrzSanchez]

Try

Sub Test()
    Dim LastRow As Long
    Dim r As Long
    With ActiveSheet
        LastRow = .Range("BK6").End(xlDown).Row
        For r = 6 To LastRow
            If .Range("BK" & r).Value = "3" Then
               With .Range("K" & r).Borders
                    .LineStyle = xlContinuous
                    .Weight = xlThick
                    .ColorIndex = xlAutomatic
                End With
            End If
        Next r
    End With
End Sub

If the BK column is numbers rather than text remove the quotes from the ="3"

You rock! Can't thank you enough!

 

[MrzSanchez]

Of course!! hahaha so like me to over complicate things for myself. Thank you Mod!!

 

[Fluff]

Glad we could help & thanks for the feedback