VBA - Double Click to create a bold border

JDCline

New Member
Joined
Dec 3, 2019
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hello,

Last December this forum helped me tremendously getting the following VBA code to work:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Target.Font.ColorIndex = IIf(Target.Interior.ColorIndex = 20, 16, 0)
Target.Interior.ColorIndex = IIf(Target.Interior.ColorIndex = 20, -4142, 20)
End Sub

It works great, but a new request has come through that the 4 borders surrounding the cell being double clicked should be changed to bold.

To add more context, the cell in it's non selected state has thin lines on the left and right, but no top and bottom lines. After double clicking, all 4 borders would like to be bold. Then when de-selected (by double clicking again) it would revert to the original state of thin side borders, and no top and bottom borders.

VBA is way over my skillset, I am hoping I can get some help. I did find some codes for borders, but frankly my blind hope and a prayer attempts (not surprisingly) didn't work.

If one of you good people could help, I would be so very grateful!

Thanks!
 

Some videos you may like

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,242
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   With Target
      If .Interior.ColorIndex = 20 Then
         .Font.ColorIndex = 16
         .Interior.ColorIndex = xlNone
         .Borders.LineStyle = xlNone
         .Borders(xlEdgeLeft).Weight = xlThin
         .Borders(xlEdgeRight).Weight = xlThin
      Else
         .Font.ColorIndex = xlAutomatic
         .Interior.ColorIndex = 20
         .BorderAround , xlMedium
      End If
   End With
End Sub
 

JDCline

New Member
Joined
Dec 3, 2019
Messages
6
Office Version
  1. 365
Platform
  1. Windows
That is pretty amazing, thank you!

The only thing that is odd is when multiple cells in a column are selected, and if someone changes their mind and then deselects a couple cells, the bottom border line remains, stays bold. I fear trying to solve that would be complicated, so I will let them know if they get that when/if they change their mind too much, to simply use the border erase tool. This portion of the excel spreadsheet is a big menu of services, in general people know what it is they want, and is doubtful this will be a frequent issue.

Thank you again!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,242
Office Version
  1. 365
Platform
  1. Windows
It can be done, but you might also remove a bold border that should remain.
 

JDCline

New Member
Joined
Dec 3, 2019
Messages
6
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

That is what I was thinking would happen. Seriously though, thank you very much!!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,891
Office Version
  1. 365
Platform
  1. Windows
The only thing that is odd is when multiple cells in a column are selected, and if someone changes their mind and then deselects a couple cells, the bottom border line remains, stays bold.
Would this do what you want in that regard?

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Cancel = True
  With Target
    If .Interior.ColorIndex = 20 Then
      .Font.ColorIndex = 16
      .Interior.ColorIndex = xlNone
      .Borders.LineStyle = xlNone
      .Borders(xlEdgeLeft).Weight = xlThin
      .Borders(xlEdgeRight).Weight = xlThin
      If Target.Row > 1 Then
        If .Offset(-1).Interior.ColorIndex = 20 Then
          .Offset(-1).BorderAround , xlMedium
        Else
          .Offset(-1).Borders(xlEdgeBottom).LineStyle = xlNone
        End If
      End If
      If Target.Row < Rows.Count Then
        If .Offset(1).Interior.ColorIndex = 20 Then
          .Offset(1).BorderAround , xlMedium
        Else
          .Offset(1).Borders(xlEdgeTop).LineStyle = xlNone
        End If
      End If
    Else
      .Font.ColorIndex = xlAutomatic
      .Interior.ColorIndex = 20
      .BorderAround , xlMedium
    End If
  End With
End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
46,891
Office Version
  1. 365
Platform
  1. Windows
You're welcome. Thanks for the follow-up. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,114,255
Messages
5,546,794
Members
410,758
Latest member
Papers
Top