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