Code Help Needed-Make Top Border Bold when entering a letter in a cell

[bamaisgreat]

I have a sheet that when I enter the letter B in column A I need the top border for that row to be bold from column A to column AL.

Thanks for your help as always.

 

[Joe4]

I think you should be able to do this quite easily with Conditional Formatting.

Here is how:
1. Determine which rows you want to apply this to, then select columns A:AL in that range (i.e. select "A3:AL100")
2. Go to Conditional Formatting and choose the formula option
3. Write the following formula as it applies to the very first row in your selected range:
=$A3="B"
4. Choose your formatting border option
5. Click "OK".

That should do it. They key is to put the "$" in front of column A in the formula. That locks that reference down and tells every column in your selected range to look at the value in column A.

 

[bamaisgreat]

Thanks Joe for the help. I had tried that but for some reason making Heavy Border is not an option in my Formatting Border Option.

 

[Joe4]

Gotcha. Right-click on sheet tab name at the bottom of the screen, select "View Code", and paste this code in the resulting VB editor window:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
    Dim r As Long
    
'   Check to see what cells just updated in column A
    Set rng = Intersect(Target, Range("A:A"))
    
'   Exit if no update made in column A
    If rng Is Nothing Then Exit Sub
    
'   Made formatting updates to cells
    For Each cell In rng
        r = cell.Row
'       See if value entered is "B"
        If cell = "B" Then
'           Apply formatting from columns A:AL
            With Range("A" & r & ":AL" & r)
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlThick
            End With
        Else
'           If not "B", then remove formatting
            With Range("A" & r & ":AL" & r)
                .Borders(xlEdgeTop).LineStyle = xlNone
            End With
        End If
    Next cell

End Sub

I also added code in there that if it was "B", and they change it to something else, it will remove the formatting.

 

[bamaisgreat]

That works great. I do have one more issue tho. I already have one change in the sheet code and when I add this one I get an error. Below are both of them in there together.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Record what cell
    ' Record new value
    ' record the day
    ' Record the time
    ' record the username
    ' Record the worksheet
        
    On Error GoTo NoLog
    Set WSN = Worksheets("Tracking")
    On Error GoTo 0
    
    NextRow = Worksheets("Tracking").Cells(Rows.Count, 1).End(xlUp).Row + 1
    If Not NextRow = Rows.Count Then
    With Worksheets("Tracking")
        
        .Cells(NextRow, 1).Value = Application.UserName
        .Cells(NextRow, 2).Value = Date
        .Cells(NextRow, 3).Value = Time
        '.Cells(NextRow, 4).Value = Target.Parent.Name
        .Cells(NextRow, 4).Value = Target.Address
        .Cells(NextRow, 5).Value = Target.Value
               
    End With
    End If


NoLog:
    ' there is not a SoxLog worksheet present, exit


End Sub


Private Sub Worksheet_Change(ByVal Target As Range)


    Dim rng As Range
    Dim cell As Range
    Dim r As Long
    
'   Check to see what cells just updated in column A
    Set rng = Intersect(Target, Range("A:A"))
    
'   Exit if no update made in column A
    If rng Is Nothing Then Exit Sub
    
'   Made formatting updates to cells
    For Each cell In rng
        r = cell.Row
'       See if value entered is "B"
        If cell = "B" Then
'           Apply formatting from columns A:AL
            With Range("A" & r & ":AL" & r)
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlThick
            End With
        Else
'           If not "B", then remove formatting
            With Range("A" & r & ":AL" & r)
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlThin
            End With
        End If
    Next cell
    End Sub

 

[Joe4]

You just need to combine them into one (you cannot have two procedures with the exact same name in the same module).
Note, I would also recommend using "Option Explicit", which forces you to declare all your variables before using them. It helps prevent errors and helps in debugging.

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    ' Record what cell
    ' Record new value
    ' record the day
    ' Record the time
    ' record the username
    ' Record the worksheet
    
    Dim WSN As Worksheet
    Dim NextRow As Long
    Dim rng As Range
    Dim cell As Range
    Dim r As Long
        
    On Error GoTo NoLog
    Set WSN = Worksheets("Tracking")
    On Error GoTo 0
    
    NextRow = Worksheets("Tracking").Cells(Rows.Count, 1).End(xlUp).Row + 1
    If Not NextRow = Rows.Count Then
        With Worksheets("Tracking")
            .Cells(NextRow, 1).Value = Application.UserName
            .Cells(NextRow, 2).Value = Date
            .Cells(NextRow, 3).Value = Time
            '.Cells(NextRow, 4).Value = Target.Parent.Name
            .Cells(NextRow, 4).Value = Target.Address
            .Cells(NextRow, 5).Value = Target.Value
        End With
    End If


'   Check to see what cells just updated in column A
    Set rng = Intersect(Target, Range("A:A"))
    
'   Exit if no update made in column A
    If rng Is Nothing Then Exit Sub
    
'   Made formatting updates to cells
    For Each cell In rng
        r = cell.Row
'       See if value entered is "B"
        If cell = "B" Then
'           Apply formatting from columns A:AL
            With Range("A" & r & ":AL" & r)
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlThick
            End With
        Else
'           If not "B", then remove formatting
            With Range("A" & r & ":AL" & r)
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeTop).Weight = xlThin
            End With
        End If
    Next cell


NoLog:
    ' there is not a SoxLog worksheet present, exit

End Sub

 

[bamaisgreat]

I wish I knew alot more about writing code. Its amazing to me what you guys can do with it.

One more edit I promise to leave you alone
Could I have it where if someone enters a B directly under a B that it will not create a Thick Border? This is an odd circumstance but it could happen.
Thanks again

 

[Joe4]

Try changing this line:

        If cell = "B" Then

to this:

        If cell = "B" And cell.Offset(-1, 0) <> "B" Then