Putting a border on my new column in my table

[dpaton05]

I have a spreadsheet that I have to record new data in every week. This spreadsheet has a table in it, which is one of the new features of excel, being able to put a table in. I have some code that will insert a new column so I can enter the data for the current week.

What I want is to be able to put a border around that new column that is added.

The table name is tblQuals and the code that I have for the new row is below.

    Columns("D:D").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "As of " & Date
    ActiveCell.Font.size = 11
    
    Columns("D:D").ColumnWidth = 18.71
    With Range("E6")
        .Copy Range("D6")
        .Clear
    End With
    
    Columns("E:E").Validation.Delete

Thanks

 

[rowebca]

What I want is to be able to put a border around that new column that is added.

What do you mean by this? The whole column, or a part (which part) ? More information please....

Regards,
GB

 

[Logit]

Try this and advise :

Option Explicit

Sub makeCo()
    Columns("D:D").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "As of " & Date
    ActiveCell.Font.Size = 11
    
    Columns("D:D").ColumnWidth = 18.71
    With Range("E6")
        .Copy Range("D6")
        .Clear
    End With
    
    Columns("E:E").Validation.Delete
    
    Const strCol As String = "D" ' <-- Change column letter here
    Dim arrBorders As Variant
    
    Dim fr As Long
    Dim lr As Long
    Dim Border As Variant
    
    fr = Cells(1, strCol).End(xlDown).Row
    lr = Cells(Rows.Count, strCol).End(xlUp).Row
    
    arrBorders = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
    
    Range("D:D").Borders.LineStyle = xlNone

    With Range(Cells(fr, strCol), Cells(lr, strCol))
        For Each Border In arrBorders
            With .Borders(Border)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .Weight = xlThick
            End With
        Next
    End With
End Sub

 

[dpaton05]

What do you mean by this? The whole column, or a part (which part) ? More information please....

Regards,
GB

So this is my column:

The new column is added in column d with a new date and I would like borders on the left and right of the new column. But then, when another week is added, I want the border around that column to disappear and for the border to be on the new column that has been added.

 

[dpaton05]

What do you mean by this? The whole column, or a part (which part) ? More information please....

Regards,
GB

So this is my column:

View attachment 118164

The new column is added in column d with a new date and I would like borders on the left and right of the new column. But then, when another week is added, I want the border around that column to disappear and for the border to be on the new column that has been added.

 

[dpaton05]

I only want the border on the column in the table, not the whole spreadsheet.

 

[dpaton05]

Try this and advise :

Option Explicit

Sub makeCo()
    Columns("D:D").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D8").Select
    ActiveCell.FormulaR1C1 = "As of " & Date
    ActiveCell.Font.Size = 11
   
    Columns("D:D").ColumnWidth = 18.71
    With Range("E6")
        .Copy Range("D6")
        .Clear
    End With
   
    Columns("E:E").Validation.Delete
   
    Const strCol As String = "D" ' <-- Change column letter here
    Dim arrBorders As Variant
   
    Dim fr As Long
    Dim lr As Long
    Dim Border As Variant
   
    fr = Cells(1, strCol).End(xlDown).Row
    lr = Cells(Rows.Count, strCol).End(xlUp).Row
   
    arrBorders = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
   
    Range("D:D").Borders.LineStyle = xlNone

    With Range(Cells(fr, strCol), Cells(lr, strCol))
        For Each Border In arrBorders
            With .Borders(Border)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .Weight = xlThick
            End With
        Next
    End With
End Sub

THat is almost there. The border goes up to D6 but the table only starts at D8. Also, when you press the button again for a new week, the old border is not deleted.

 

[dpaton05]

THat is almost there. The border goes up to D6 but the table only starts at D8. Also, when you press the button again for a new week, the old border is not deleted.

With the above, I want the border to start in D8 and go to the end of the table.

 

[Peter_SSs]

It seems to me that because you are inserting a whole column, you then have to adjust other things that are outside of the table.
Would it be reasonable to only add the column within the table and not above/below it as well so that the 'outside' rearrangements are not required?
See if this is close to what you are trying to achieve.

I have assumed that your table starts in column A and that the current 4th column already has left and right borders

Sub Test()
  With ActiveSheet.ListObjects("tblQuals")
    .ListColumns.Add Position:=4
    With .ListColumns(4).Range
      .Resize(, 2).ColumnWidth = 18.71
      .Cells(1).Value = "As of " & Date
      .Cells(1).Font.Size = 11
      .Offset(, 1).Borders(xlEdgeRight).LineStyle = xlNone
      .Borders(xlEdgeLeft).LineStyle = xlContinuous
    End With
  End With
End Sub

 

[dpaton05]

Thanks Peter,

That works pretty well but the bottom border got pushed across 1 column and part of the left border had it's thickness reduced.

See the attached images.