Auto change borders to thick borders

Bumping along

Bumping along

Bumping along

Hi Pierce,
It is only possible with a macro.
Copy this macro in your SHEET module. Double click on cell A1 to activate the macro.
Note : you can remove the conditional formatting for the horizontal line.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim rg As Range, c As Range
   If Not Intersect([A1], Target) Is Nothing Then
      Set rg = Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row + 1)
      For Each c In rg
         With c.Offset(0, -4).Resize(1, 6).Borders(xlEdgeTop)
            .LineStyle = xlNone
            If c.Offset(-1, 0).Value <> c.Value Then
               .LineStyle = xlContinuous
               .Weight = xlMedium
            End If
         End With
      Next c
   End If
   Cancel = True
End Sub

Originally Posted by GC Excel

Hi Pierce,
It is only possible with a macro.
Copy this macro in your SHEET module. Double click on cell A1 to activate the macro.
Note : you can remove the conditional formatting for the horizontal line.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Dim rg As Range, c As Range
   If Not Intersect([A1], Target) Is Nothing Then
      Set rg = Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row + 1)
      For Each c In rg
         With c.Offset(0, -4).Resize(1, 6).Borders(xlEdgeTop)
            .LineStyle = xlNone
            If c.Offset(-1, 0).Value <> c.Value Then
               .LineStyle = xlContinuous
               .Weight = xlMedium
            End If
         End With
      Next c
   End If
   Cancel = True
End Sub

Thank you very much! I changed the format to a macro enabled workbook, but am unsure exactly how to copy the macro properly, Im very new to VB, only having completed a quick 'Hello World" intro a few years ago. Could you please advise me on the procedure to copy the macro into my sheet module? Thanks!

From Excel : ALT + F11 to open the VBA editor
You should have a listing of VBA projects in the left pane, if not, press CTRL + R to show it
Find your file in the list and under "Microsoft Excel Objects", double click on your sheet "Sheet1 (Current)".
Copy the code in the white box on the right.

See picture...

Thank you very much for the explanation! I was able to get the macro to work when I double click on A2, but I was wondering a couple of things; is it possible to get the macro to activate with out double clicking? When I copy my info on to our page there will always be an instance in E2 so maybe it could work off of that? Also, is it possible to have the vertical outside borders a thick border like the horizontal lines? Thanks again!

Hi Pierce,
I changed the macro. It will launch automatically when cell E2 is changed.

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rg As Range, c As Range
   If Not Intersect([E2], Target) Is Nothing Then
      Set rg = Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row + 1)
      For Each c In rg
         With c.Offset(0, -4).Resize(1, 6)
            With .Borders(xlEdgeTop)
               .LineStyle = xlNone
               If c.Offset(-1, 0).Value <> c.Value Then
                  .LineStyle = xlContinuous
                  .Weight = xlMedium
               End If
            End With
            With .Borders(xlEdgeLeft)
               .LineStyle = xlContinuous
               .Weight = xlMedium
            End With
            With .Borders(xlEdgeRight)
               .LineStyle = xlContinuous
               .Weight = xlMedium
            End With
         End With
      Next c
   End If
   Cancel = True
End Sub

Originally Posted by GC Excel

Hi Pierce,
I changed the macro. It will launch automatically when cell E2 is changed.

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rg As Range, c As Range
   If Not Intersect([E2], Target) Is Nothing Then
      Set rg = Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row + 1)
      For Each c In rg
         With c.Offset(0, -4).Resize(1, 6)
            With .Borders(xlEdgeTop)
               .LineStyle = xlNone
               If c.Offset(-1, 0).Value <> c.Value Then
                  .LineStyle = xlContinuous
                  .Weight = xlMedium
               End If
            End With
            With .Borders(xlEdgeLeft)
               .LineStyle = xlContinuous
               .Weight = xlMedium
            End With
            With .Borders(xlEdgeRight)
               .LineStyle = xlContinuous
               .Weight = xlMedium
            End With
         End With
      Next c
   End If
   Cancel = True
End Sub

Thank you very much, this is what we were looking for!

Hi All,
As a late add in, we were wondering if it is possible to get the two vertical column lines that stick out on the bottom after the information is pasted in to not appear. Ive tried without success so far and was wondering of someone could point me in the right direction. Its a very minor detail but one my boss would like to see resolved
Thanks!

i'm in a similar situation with the conditional formatting limitations and thick border style. I'm looking for code that will look at each row for certain specific names in Column A (John doe, jane doe, micky mouse, minny mouse) and if the one of those names are in column A, then the entire row is formatted with a Thick Top Border.
I am using the following code to Bold and shade the row, but it wont make the top border thick. Any suggestions would be greatly appreciated :-)

Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=IF($A1=""John Doe"", TRUE, IF($A1=""Jane Doe"", TRUE, IF($A1=""Micky Mouse"", TRUE,IF($A1=""Minny Mouse"", FALSE))))"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.799981688894314
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
Selection.FormatConditions(1).StopIfTrue = False