Automatically adding columns to RSS tables in excel

[fluffynicesheep]

Hi,

I have a spreadsheet with numerous tabs in. Every single tab has a similar RSS feed imported into it (so it becomes a table). At the moment the final column on each tab (and therefore in each table) is always going to be column H.

Is there any easy way to therefore automate the following through VBA:

1) Add 1 blank column to the end of every table in every tab (Column I), and
2) format column I as a UK date, and then
3) Enter the datevalue formula into column I - so it converts column H into a date (e.g. =DATEVALUE([@pubDate]))
4) Then change the heading of the new column I to "Date"

I know it's a bit of a long shot, but thought it best to ask before I set off making the changes manually myself!

Thanks

 

[John_w]

Try this macro. Note that although NumberFormat looks like an American date, it displays the date in the default format for your locale. Or you can use your own date format string.

Public Sub Add_Column_To_Table_In_Each_Sheet()

    Dim ws As Worksheet
    Dim table As ListObject
    
    For Each ws In ActiveWorkbook.Worksheets
        Set table = ws.ListObjects(1)
        table.ListColumns.Add
        With table.ListColumns(table.ListColumns.Count)
            .Range(1, 1).Value = "Date"
            .DataBodyRange.NumberFormat = "m/d/yyyy"
            .DataBodyRange.Formula = "=DATEVALUE([@pubDate])"
        End With
    Next
    
End Sub

 

[fluffynicesheep]

Thanks John,

Unfortunately I get an error with this line:

 Set table = ws.ListObjects(1)

 

[John_w]

Maybe not all sheets have a table then.

Public Sub Add_Column_To_Table_In_Each_Sheet()

    Dim ws As Worksheet
    Dim table As ListObject
    
    For Each ws In ActiveWorkbook.Worksheets
        Set table = Nothing
        On Error Resume Next
        Set table = ws.ListObjects(1)
        On Error GoTo 0
        If Not table Is Nothing Then
            table.ListColumns.Add
            With table.ListColumns(table.ListColumns.Count)
                .Range(1, 1).Value = "Date"
                .DataBodyRange.NumberFormat = "m/d/yyyy"
                .DataBodyRange.Formula = "=DATEVALUE([@pubDate])"
            End With
        End If
    Next
    
End Sub

 

[fluffynicesheep]

That's perfect, thanks so much.

 

[fluffynicesheep]

Hi,

Sorry to reopen this ..but I've just added more tables/worksheets into the existing workbook, and wanted to know if there was any way that I could use the above code again, but with the new tables only? So this would mean that the table would have to end at column H, in order for the macro to then kick in ....

If the table already ended after column H, it means that the last code had been run previously, and I therefore don't need to add another column.

If anyone can help again that would be fantastic!

 

[veyselemre]

Public Sub Add_Column_To_Table_In_Each_Sheet()

    Dim ws As Worksheet
    Dim table As ListObject


    For Each ws In ActiveWorkbook.Worksheets
        Set table = Nothing
        On Error Resume Next
        Set table = ws.ListObjects(1)
        On Error GoTo 0
        If Not table Is Nothing Then
            If table.ListColumns.Count < 8 Then
                table.ListColumns.Add
                With table.ListColumns(table.ListColumns.Count)
                    .Range(1, 1).Value = "Date"
                    .DataBodyRange.NumberFormat = "m/d/yyyy"
                    .DataBodyRange.Formula = "=DATEVALUE([@pubDate])"
                End With
            End If
        End If
    Next


End Sub

 

[veyselemre]

Public Sub Add_Column_To_Table_In_Each_Sheet()
    Dim ws As Worksheet
    Dim table As ListObject


    For Each ws In ActiveWorkbook.Worksheets
        If ws.ListObjects.Count > 0 Then
            Set table = ws.ListObjects(1)
            If table.ListColumns.Count < 8 Then
                With table.ListColumns.Add
                    .Range(1, 1).Value = "Date"
                    .DataBodyRange.NumberFormat = "m/d/yyyy"
                    .DataBodyRange.Formula = "=DATEVALUE([@pubDate])"
                End With
            End If
        End If
    Next


End Sub

 

[fluffynicesheep]

Hi,

Unfortunately this hasn't worked - nothing is happening at all

 

[fluffynicesheep]

Hi veyselemre

Unfortunately neither of the above codes did anything.