Change Event Removes my Border?

[Anne Troy]

Here's my code

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then
    Exit Sub
End If
On Error GoTo ErrHandler:
If Not Application.Intersect(Me.Range("D3:D6"), Target) Is Nothing Then
    If IsNumeric(Target.Value) = False Then
        Application.EnableEvents = False
        'Target.Value = StrConv(Target.Text, vbLowerCase)
        'Target.Value = StrConv(Target.Text, vbUpperCase)
        'Target.Value = StrConv(Target.Text, vbProperCase)
        With Target
            .Value = StrConv(Target.Text, vbLowerCase)
            .Hyperlinks.Delete
            .HorizontalAlignment = xlCenter

       End With
        Application.EnableEvents = True
    End If
End If
ErrHandler:
Application.EnableEvents = True
End Sub

When I enter an email addy into one of those cells, and hit Enter or Tab, it's beautiful. But I am now missing some of my border. So, fine. I put borders on the top and right of cell D3, and that resolves it for D3, but not for D4, D5... you get me. How can I either figure out why it's doing this or put the borders back on?

 

[Anne Troy]

Well, this is an interesting anomaly, but I have resolved it by putting conditional formatting on the cell so that if it is blank it has a border, and if it is non-blank it has a border. LOL Thanks for looking anyway!

 

[GlennUK]

How odd!

 

[AD_Taylor]

Its actually the Hyperlinks.Delete bit thats doing it if you wanted to know. I have no idea why or how but when removing hyperlinks the border goes as well. Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim bordersArray(1 To 4) As String

If Target.Cells.Count > 1 Then
    Exit Sub
End If
On Error GoTo ErrHandler:

If Not Application.Intersect(Me.Range("D3:D6"), Target) Is Nothing Then
    If IsNumeric(Target.Value) = False Then
        Application.EnableEvents = False
        'Target.Value = StrConv(Target.Text, vbLowerCase)
        'Target.Value = StrConv(Target.Text, vbUpperCase)
        'Target.Value = StrConv(Target.Text, vbProperCase)
        With Target
            .Value = StrConv(Target.Text, vbLowerCase)
            
            bordersArray(1) = .Borders(xlEdgeBottom).LineStyle
            bordersArray(2) = .Borders(xlEdgeTop).LineStyle
            bordersArray(3) = .Borders(xlEdgeLeft).LineStyle
            bordersArray(4) = .Borders(xlEdgeRight).LineStyle
                       
            .Hyperlinks.Delete
            
            .Borders(xlEdgeBottom).LineStyle = bordersArray(1)
            .Borders(xlEdgeTop).LineStyle = bordersArray(2)
            .Borders(xlEdgeLeft).LineStyle = bordersArray(3)
            .Borders(xlEdgeRight).LineStyle = bordersArray(4)
                        
            .HorizontalAlignment = xlCenter

       End With
        Application.EnableEvents = True
    End If
End If
ErrHandler:
Application.EnableEvents = True
End Sub

I've added a string array to store the borders information from all 4 sides before deleting the hyperlinks and then restore it after.

Hope this helps!
Adam

 

[Anne Troy]

Nice! Thanks!!