Create Tables in VBA

Hatch10

New Member
Joined
Oct 29, 2013
Messages
14
I have an Excel Workbook downloaded from an Internet site. It has only one sheet with 50 suppliers listed on it. Each supplier is shown with a header row and the next row shows the shipping parameters in 10 columns. I need a VBA code for Excel 10 to loop through the sheet and create tables and rename the table for each shipper. I can record a macro that works fine, but the shippers change over time then the macro will not work. When recording the macro I click on the first column in the row showing the parameters (Shipper ID) and Excel knows the range for the table. I am new to VBA and trying to learn, any help is appreciated.
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Hi and Welcome to the Board,

I'm not clearly understanding the setup of your sheet. It sounds like the first suppliers data would be in the Range A1:J2 (2 rows by 10 columns).
So you want to convert that range into a Table- is that correct? What cell has the value to be used in renaming the Table?

Then onto the other 49 or so suppliers. Would the next one's data be at A3:J4 or skip a blank row to A4:J5 or is it somewhere else?
 
Last edited:
Upvote 0
The sheet has a total of 4318 rows. Cell A1 is the title of the sheet, cell A2 shows the date range, row 3 is blank and Cell A4 shows the supplier name, row 5 shows the header. If I click on cell A5 (Barge No.) and insert a table the range is $A$4:$J$142 and cell A4 contains the value to be used in renaming the table. Row 142 is the Totals row, row 143 is blank and cell A144 is the next shipper. The entire sheet is formatted this way. A routine to sort the tables by ship date (Column B) would also be helpful. See the screen shot. Thanks.

AEP 2614/12/20131671.50.896.657.7532.7630000941.03
AEP 6324/18/20131756.530.896.517.8632.3130000981.07
AEP 1345/10/20131667.240.876.237.5531.1730000981.04
AEP 2795/10/20131686.240.866.37.4431.1730000981.04
HO 2335/28/20131663.240.796.576.831.9730000981.03
AEP 2876/5/20131685.660.916.498.2832.1630000971.05
AEP 3216/7/20131700.410.836.397.6832.3330000981.03
Total Tons:319532.91
GREEN MTN
Barge No.Ship DateTonsSulfurAshMoistureVMFluidityOxidationRO
ING 15555/2/20131681.750.987.425.0132.1130000 1.08
ING 55085/2/20131691.950.987.784.8232.1130000 1.06
OR 54295/2/20131833.40.987.525.5232.1130000 1.08
Total Tons:5207.1
GREENBRIER QUIN
Barge No.Ship DateTonsSulfurAshMoistureVMFluidityOxidationRO
TRK 44/3/2013991.561.135.47.1125.89531794
TRK 44/17/2013710.971.127.267.725.12802698
TRK 44/22/2013777.271.188.216.2824.77644298
TRK 44/26/2013633.651.116.837.1125.35496597
TRK 45/3/20135901.16.875.7325.51118999
TRK 45/8/2013856.31.087.339.6226.48778099

<colgroup><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>
 
Upvote 0
In your example, if A4 is the Supplier name, the headers are on Row 5, and you make a Table using the Range: $A$4:$J$142, that adds a new set of field headers Column1, Column2....with autofilters in $B4:J4, which looks messy and less functional than having your headers in Row 5 be the field headers of your table.

I'd suggest starting your first Table at Row 5 and either leaving the Supplier name in A4 (above the table) or moving the Supplier Name into an added field in the Table.

Similarly, it would be cleaner to have the "Total Tons" value align with the Tons field.
 
Last edited:
Upvote 0
Thanks, I agree that would improve the appearance. What I am trying to do is write a code to loop through the entire sheet and automatically create the tables. There will be currently 50 tables and some change daily. Over time, other suppliers may be added and they always appear on the sheets in alphabetical order.

My idea is to put these tables on separate worksheets in a workbook so I can link my files to them and not have to reenter the data. I have already got the code to find the supplier name and create a list of suppliers then create the worksheets from that list. But then I get lost in the programming.

The reason for linking my files is that I maintain charts on each supplier showing in spec shipping performance, and all other specification parameters. If I can link my files it would save an enormous of time.
 
Upvote 0
Let's start with some code to address the questions in your Original Post.

Below is some code you can try. Paste all the code into a Standard Code Module, then run the MakeTables macro.

Code:
Sub MakeTables()
    Dim cFound As Range
    Dim sFirstAddr As String
    Dim lRows As Long
    Dim tbl As ListObject
    
    With ActiveSheet
        '--find first match for field name in Col A.
        Set cFound = .Range("A:A").Cells.Find(What:="Barge No.", _
            After:=.Range("A1"), LookAt:=xlWhole, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        If Not cFound Is Nothing Then
            sFirstAddr = cFound.Address
            Do Until cFound Is Nothing
                '--find last row before blank cell, calc no. of rows
                With cFound
                    lRows = .End(xlDown).Row - .Row + 1
                End With
                
                '--continue if invalid table name or range
                On Error Resume Next
                Set tbl = .ListObjects.Add(xlSrcRange, _
                    cFound.Resize(lRows, 10), , xlYes)
                tbl.Name = cFound(0)
                On Error GoTo 0
                
                If Not tbl Is Nothing Then
                    Call FormatTable(tbl)
                End If
                '--find next match for field name in Col A.
                Set cFound = .Cells.FindNext(After:=cFound(lRows))
                If cFound.Address = sFirstAddr Then
                    Exit Do
                End If
            Loop
        End If
    End With
End Sub

Private Function FormatTable(tbl As ListObject)
'--customize to include sorting, totals or formatting
    With tbl
        '--delete existing total if any
        With .ListRows(.ListRows.Count)
            If .Range(1, 1) = "Total Tons:" Then .Delete
        End With
         
        '--add totals row and formula for Tons field
        .ShowTotals = True
        With .TotalsRowRange
            .Cells(1, .Columns.Count).ClearContents
            Intersect(.ListObject.ListColumns("Tons").Range, _
                .Cells).Formula = "=SUBTOTAL(109,[Tons])"
        End With

        '--sort by Ship Date field
        With .Sort
            .SortFields.Add Key:=tbl.ListColumns("Ship Date").Range, _
                SortOn:=xlSortOnValues, Order:=xlAscending
            .Header = xlYes
            .Orientation = xlTopToBottom
            .Apply
        End With
    End With
End Function
 
Upvote 0
Thank you, that worked perfectly. I guess it is like that old saying: "If you know what you are doing it is awfully simple, if you don't it is simply awful." I will study this and try to learn from it.

Now I need code to copy the tables to a worksheet with the same name and to sort the tables by date (Column B).
 
Upvote 0
Thank you, that worked perfectly. I guess it is like that old saying: "If you know what you are doing it is awfully simple, if you don't it is simply awful." I will study this and try to learn from it.

Now I need code to copy the tables to a worksheet with the same name and to sort the tables by date (Column B).

You're welcome.

The code I suggested already sorts by date in Column B. See the code under this remark: '--sort by Ship Date field

A good way to learn is to take code that is already working and make very minor tweaks with the aid of the macro recorder.

Try manually recording the steps of adding a new sheet, cutting and pasting one table to that new sheet, and renaming the sheet to match the table name.

Then try incorporating the recorded code into your existing framework at this spot....

Code:
If Not tbl Is Nothing Then
    Call FormatTable(tbl)
	
    '--code to add sheet
           '-----add your code here

    '--code to cut-paste table
           '-----add your code here

     '--code to rename new sheet
           '-----add your code here

End If

Make sure to get each one of these 3 steps working perfectly before you move on to the next.

Good luck. Just ask if you get stuck. :)
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,520
Messages
6,114,099
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top