vba formatting used range with border

[zakasnak]

Hi all,

I found this code & it works, but I need to alter it so that only the top, bottom, and internal horizontal are bordered (no internal verticals). My range is Col A-F, variable number of rows, do not border the header row A1:F1.

Help?

Sub TheWall()


Application.ScreenUpdating = False
Dim lngLstCol As Long, lngLstRow As Long


lngLstRow = ActiveSheet.UsedRange.Rows.Count
lngLstCol = ActiveSheet.UsedRange.Columns.Count


For Each rngCell In Range("A2:A" & lngLstRow)
    If rngCell.Value > "" Then
        r = rngCell.Row
        c = rngCell.Column
        Range(Cells(r, c), Cells(r, lngLstCol)).Select
            With Selection.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
    End If
Next


Application.ScreenUpdating = True


End Sub

 

[Zenwood]

Try adding

.Borders(xlInsideVertical).LineStyle = xlNone

 

[zakasnak]

nope... I did find a workaround....

Sub TheWall()


Application.ScreenUpdating = False
Dim lngLstCol As Long, lngLstRow As Long


lngLstRow = ActiveSheet.UsedRange.Rows.Count
lngLstCol = ActiveSheet.UsedRange.Columns.Count


For Each rngCell In Range("A2:A" & lngLstRow)
    If rngCell.Value > "" Then
        r = rngCell.Row
        c = rngCell.Column
        Range(Cells(r, c), Cells(r, lngLstCol)).Select
            With Selection.Borders
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = xlAutomatic
            End With
    End If
Next


    Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("A2").Select


Application.ScreenUpdating = True
End Sub