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

bamaisgreat

Well-known Member
Joined
Jan 23, 2012
Messages
794
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.
 

Some videos you may like

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,968
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Jan 23, 2012
Messages
794
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,968
Office Version
  1. 365
Platform
  1. Windows
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:
Code:
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

Well-known Member
Joined
Jan 23, 2012
Messages
794

ADVERTISEMENT

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.

Code:
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,968
Office Version
  1. 365
Platform
  1. Windows
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.
Code:
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

Well-known Member
Joined
Jan 23, 2012
Messages
794
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

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
55,968
Office Version
  1. 365
Platform
  1. Windows
Try changing this line:
Code:
        If cell = "B" Then
to this:
Code:
        If cell = "B" And cell.Offset(-1, 0) <> "B" Then
 

Watch MrExcel Video

Forum statistics

Threads
1,123,122
Messages
5,599,830
Members
414,341
Latest member
Mohammedsobhey

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top