Creating tables across multiple tabs

Question

I use an addon to pull 62 reports out of Salesforce.com into Excel. The addon puts each report onto a separate tab in a worksheet (which is perfect). Previously, I was copying and pasting into another worksheet that was a mirror copy, except it had tables set up on each tab. I am looking for a way to cut down on my copying and set up a macro that would automatically select the range on a tab, create a table, and continue across all 62 tabs. The problem I run into is each tab contains a variable amount of rows.

Part of my formatting macros have a range down to row 580, which is a safe distance for me to format specific cells for purposes of text color. As I have been hobbling around trying to create the tables, this compounds what I have as it creates the table all the way down to row 580. If there is a way to select only cells that have data in them for specific columns (minus Row A which would be the table header), that would work too. I only need the table to encompass the rows that contain information.

I have submitted the current macro I use:

Sub SAR_Format()
'
' SAR_Format Macro
' SAR Table Formating
'

'
    Dim ws As Worksheet
    For Each ws In Sheets
    ws.Activate
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:G").Select
    Selection.ColumnWidth = 7.86
    Selection.ColumnWidth = 10
    Columns("H:H").Select
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").EntireColumn.AutoFit
    Columns("L:L").ColumnWidth = 8.86
    Columns("L:L").ColumnWidth = 7.57
    Rows("1:1").RowHeight = 29.25
        With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With
        Columns("M:M").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
    ActiveWindow.ScrollColumn = 2
    Columns("N:N").EntireColumn.AutoFit
    Columns("O:O").EntireColumn.AutoFit
    Columns("P:P").EntireColumn.AutoFit
    ActiveWindow.ScrollColumn = 1
    Range("C2:G580").Select
    Selection.NumberFormat = "$#,##0_);[Red]($#,##0)"
    With Selection.Font
        .Color = -65536
        .TintAndShade = 0
    End With
    Range("A2:P580").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
         End With
         ActiveWindow.SmallScroll Down:=-348
    ActiveWindow.ScrollRow = 191
    ActiveWindow.ScrollRow = 189
    ActiveWindow.ScrollRow = 186
    ActiveWindow.ScrollRow = 184
    ActiveWindow.ScrollRow = 179
    ActiveWindow.ScrollRow = 174
    ActiveWindow.ScrollRow = 167
    ActiveWindow.ScrollRow = 159
    ActiveWindow.ScrollRow = 149
    ActiveWindow.ScrollRow = 141
    ActiveWindow.ScrollRow = 133
    ActiveWindow.ScrollRow = 124
    ActiveWindow.ScrollRow = 118
    ActiveWindow.ScrollRow = 89
    ActiveWindow.ScrollRow = 86
    ActiveWindow.ScrollRow = 82
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 76
    ActiveWindow.ScrollRow = 74
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 67
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 63
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2

    Next ws
End Sub

This macro fixes my column widths, gives my the appropriate font size, format, and color for specific cells, but does not create the table.

Just look here for how to find the last row that has data: http://stackoverflow.com/questions/71180/how-can-i-find-last-row-that-contains-data-in-the-excel-sheet-with-a-macro Courtesy of googling this: `excel find last row containing data` — Marc, Nov 17 '15 at 18:11
Got few questions: 1) Does your data starts at A1, if not at what cell? 2) Is the body of your data continuous or has blank rows or blank columns in between? 3) Does the prior info applies to all worksheets? — EEM, Nov 17 '15 at 19:27

score 0 · Accepted Answer · answered Nov 18 '15 at 04:01

I have done some modifications your original code (see comments in the code). This solution assumes the Reports Data starts at A1

Sub SAR_Format()
Dim Wsh As Worksheet, Lob As ListObject
Dim rSrc As Range, lRowLst As Long

    Rem Loop Through Each Worksheet in Workbook
    For Each Wsh In ThisWorkbook.Worksheets  'Use this line if procedure is in the workbook with data
    'For Each ws In Workbooks("WbkName").Sheets  'Use this line if procedure is not in the workbook with data - update workbook name

        With Wsh

            Rem Set Source Range
            Application.Goto .Cells(1), 1
            lRowLst = .Cells(.Rows.Count, 1).End(xlUp).Row     'Get Last row of data
            Set rSrc = .Range("A1:P" & lRowLst)

            Rem Add ListObject - Excel Table
            Set Lob = .ListObjects.Add(xlSrcRange, rSrc, , xlYes)

        End With

        Rem Work with Excel Table (ListObject in VBA)
        With Lob
            .TableStyle = "TableStyleMedium6"
            .ShowTableStyleRowStripes = False

            Rem Header Settings
            With .HeaderRowRange
                .RowHeight = 29.25

                'It's not clear if this setting corresponds to the header or to columns H
                'I have it in both just delete the one no needed
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With

            Rem Body Settings
            With .DataBodyRange
                With Range(.Columns(3), .Columns(7))
                    .NumberFormat = "$#,##0_);[Red]($#,##0)"
                    .Font.Color = RGB(0, 0, 255)
                End With

                'It's not clear if this setting corresponds to the header or to columns H
                'I have it in both just delete the one no needed
'                With .Columns(8)
'                    .HorizontalAlignment = xlGeneral
'                    .VerticalAlignment = xlBottom
'                    .WrapText = True
'                    .Orientation = 0
'                    .AddIndent = False
'                    .IndentLevel = 0
'                    .ShrinkToFit = False
'                    .ReadingOrder = xlContext
'                    .MergeCells = False
'                End With
            End With

            Rem General Settings
            With .Range
                .Font.Name = "Calibri"
                .Font.Size = 10
                .EntireColumn.AutoFit
                .Columns(12).ColumnWidth = 7.57
                Range(.Columns(3), .Columns(7)).ColumnWidth = 10
            End With

    End With: Next

End Sub

Suggest to visit these pages:

Variables & Constants, Application Object (Excel), Excel Objects

With Statement, Range Object (Excel), ListObject Members (Excel)

Do let me know of any question you might have about the code.

I get an error with "Set Lob = .ListObjects.Add(xlSrcRange, rSrc, , xlYes)" it says "A table cannot overlap another table" — , Nov 19 '15 at 02:28
It seems that there is already a table in the range you want to create a table. Did you ran several times the procedure. I can have the procedure to remove any other table in the sheet before proceeding, It's that what you want? Perhaps you need to share your workbook so I can see exactly what's the problem... — EEM, Nov 19 '15 at 05:57
I get the same error on a test workbook. I just threw some random text in the cells and ran the macro, and get the same error. — , Nov 23 '15 at 13:37
I cannot reproduce that error, can you share your workbook so I can have a look at it... — EEM, Nov 23 '15 at 13:47
The only way to reproduce the error is if you run the procedure a **second time** to the same workbook... — EEM, Nov 23 '15 at 14:00
Raw data downloaded and saved without anything else - https://www.dropbox.com/s/1dv0sverxoa08ts/raw%20data.xlsx?dl=0 — , Nov 25 '15 at 02:13
Desired outlook from the macro - https://www.dropbox.com/s/3n63d3w42wxqbgg/finished%20version.xlsx?dl=0 — , Nov 25 '15 at 02:14
Ran the project to the Raw data and it worked fine. The procedure is Ok, you must be doing something different. As mentioned before, I only get that error when I try to run it twice... — EEM, Nov 25 '15 at 17:22
Yeah, I dont know. I am confused now. If I run the macro on my laptop with the raw data workbook that I provided you, the macro runs just fine as you intended (Thank you). When I do it on my desktop with the same everything, I get that error. — , Nov 26 '15 at 02:05
I think I got it. The macro was saved in my PERSONAL.XLSB, so I could access it every week when I download new data. Looks like it made a table in that workbook and saved it, hence the error message. — , Nov 26 '15 at 02:08
That's the idea of these lines, you need to select the one that applies to your settings: `Rem Loop Through Each Worksheet in Workbook` `For Each Wsh In ThisWorkbook.Worksheets 'Use this line if procedure is in the workbook with data` `'For Each ws In Workbooks("WbkName").Sheets 'Use this line if procedure is not in the workbook with data - update workbook name` or use this to work with the activeworkbook `'For Each ws In ActiveWorkbook.Sheets` — EEM, Nov 26 '15 at 02:32

Creating tables across multiple tabs

1 Answers1