Dynamic Table creation

[Asdusp]

Hi guys,
I'm working at table creation of many archives, need a dynamic code for differents rows.
All I got is this:
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$D$520"), , xlYes).Name = "Tabela1"

But I want a General Row selection, some archives have 520 rows, others 200, 300, x...
is that a way to make it?
Thanks!

 

[shell_l_d]

I use this CreateTable() procedure to dynamically create a table at cell A2 on the selected worksheet. I call it for multiple worksheets.

Private Const scModuleName As String = "Module3."

Sub CreateTable()
      '---------------------------------------------------------------------------------------
      ' Procedure  : CreateTable
      ' Author     : shell_l_d
      ' Date       : 10Jul2010
      ' Purpose    : Create table at A2 on selected worksheet (tablestyle,totalrow,freezepanes,autofit)
      '---------------------------------------------------------------------------------------

          ' For Error Reporting
          Dim sErrorDescr As String
          Const sErrSource As String = scModuleName & "CreateTable"
1         On Error GoTo Error_In_CreateTable

          Dim iLastCol As Integer, iLastRow As Integer, iPos As Integer, iMaxWidth As Integer
          Dim sEndTable As String, sLastColRef As String, sTblName As String
          Dim oRngCol As Object
          
2         iMaxWidth = 20
          
3         If ActiveSheet.Name = "Update" Then
4             GoTo Exit_CreateTable
5         ElseIf ActiveSheet.Name = "VbReferences" Or ActiveSheet.Name = "TimeZones" Then
6             iMaxWidth = 0
7         End If
          
8         With ActiveSheet
              
9             .Range("A2").Select
10            sTblName = "tbl" & .Name

              ' Set Font type & size for worksheet
11            .Cells.Font.Size = 10

              ' find position of entire table including headings
12            iLastCol = .Range("A1").End(xlToRight).Column
13            iLastRow = 1    ' default in case no data
              
              ' Ignore possible Error '6 Overflow' if only header exists (no data)
14            On Error Resume Next
15            iLastRow = .Range("A1").End(xlDown).Row
16            On Error GoTo Error_In_CreateTable
              
              ' extract the column letter from sEndTable  eg: AB from "$AB$100"
17            sEndTable = .Cells(iLastRow, iLastCol).Address
18            iPos = VBA.InStrRev(sEndTable, "$", -1)
19            sLastColRef = VBA.Mid(sEndTable, 2, iPos - 2)
              
              ' Add table - ignore error if table already exists
20            On Error Resume Next
21            .ListObjects.Add(xlSrcRange, Range("$A$1:" & sEndTable), , xlYes).Name = sTblName
22            On Error GoTo Error_In_CreateTable
              
              ' Tablestyle for new table (adds filtering, colours & totals)
23            With .ListObjects(sTblName)
24                .TableStyle = "TableStyleMedium9"  ' blue
25                .ShowHeaders = True
26                .ShowTotals = True
27            End With

              ' iRow height
28            .Rows("1:1").RowHeight = 40             'headings
29            .Rows("2:" & iLastRow).RowHeight = 15   'data
              
              ' Column width & max width
30            .Cells.EntireColumn.AutoFit
31            With Columns("A:" & sLastColRef)
32                For Each oRngCol In .Columns
33                    If iMaxWidth > 0 And oRngCol.ColumnWidth > iMaxWidth Then
34                        oRngCol.ColumnWidth = iMaxWidth
35                    End If
36                Next
37            End With

              ' Format Headings
38            Range(sTblName & "[#Headers]").Select
39            With Selection
40                .HorizontalAlignment = xlCenter
41                .VerticalAlignment = xlCenter
42                .WrapText = True
43            End With

              ' Freeze panes below headings
44            ActiveWindow.FreezePanes = False
45            Range("C2").Select
46            ActiveWindow.FreezePanes = True

47        End With
              
      ' ===== Exit Handler =====
Exit_CreateTable:
48        On Error Resume Next
          ' Release memory used by Objects
49        If Not oRngCol Is Nothing Then oRngCol = Nothing
50        Exit Sub

      ' ===== ERROR HANDLER =====
Error_In_CreateTable:

51        With Err
52            sErrorDescr = "Error '" & .Number & " " & _
                  .Description & "' occurred in " & sErrSource & _
                  IIf(Erl <> 0, " at line " & CStr(Erl) & ".", ".")
53        End With

54        Select Case MsgBox(sErrorDescr, vbAbortRetryIgnore, "Error in " & sErrSource)
              Case vbRetry
55                Resume
56            Case vbIgnore
57                Resume Next
58            Case Else
59                Resume Exit_CreateTable
60            End
61        End Select

End Sub

 

[General Ledger]

shell_l_d

Awesome creation!!

The comments really help me to understand what is going on.

I have a few points for my situation that I wonder if you have already addressed:

Early in the macro, test to see if the file is .xlsx If not, SaveAs .xlsx before continuing on in macro.

Now that the Table is created, I need a macro that will create a PivotTable from the Table.

Thanks,

GL

 

[shell_l_d]

Thanks GL. No sorry haven't used that in my code.

I did alot of googling to find what I needed & also to create macro's & experiment/edit/play with the created code to learn from it.

Try googling 'VBA Excel saveas xlsx'
eg: extracts from 1st in list:

http://www.rondebruin.nl/saveas.htm

In Excel 2007-2010, SaveAs requires you to provide both the FileFormat parameter
and the correct file extension.

For example, in Excel 2007-2010, this will fail if the ActiveWorkbook is not an xlsm file
ActiveWorkbook.SaveAs "C:\ron.xlsm"

This code will always work
ActiveWorkbook.SaveAs "C:\ron.xlsm", fileformat:=52
' 52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007-2010)

 

[General Ledger]

shell_l_d,

I might have found a "bug" in the code. I get:

Error '1004 Application-defined or object-defined error' occurred in CreatTable at line 38.

38            Range(sTblName & "[#Headers]").Select

This seems to occur when the code that creates the table name based on the sheet name results in a name with an underscore. This happens when the sheet name has an underscore in it (Sheet_1) or the sheet name has spaces (Jan 2011) and VBA replaces the spaces with underscores.

10            sTblName = "tbl" & .Name

Excel has no trouble creating the table name with the underscores but has an issue with the code that selects the header row of a table with an underscore in the name.

Here is the fix I used:

38            Rows("1:1").Select

Thanks again for the GREAT code.

 

[General Ledger]

shell_l_d,

I have been experiencing a problem. At line 15, the iLastRow is not updating from 1 to the number of rows in the data.

8         With ActiveSheet
 
9             .Range("A2").Select
 
              ' Name table
10            sTblName = "tbl" & .NAME
              ' Set Font for worksheet
11            '.Cells.Font.Size = 10
              ' Find position of entire table including headings
12            iLastCol = .Range("A1").End(xlToRight).Column
13            iLastRow = 1    ' default in case no data
 
              ' Ignore possible Error '6 Overflow' if only header exists (no data)
14            On Error Resume Next
15            iLastRow = .Range("A1").End(xlDown).Row
16            On Error GoTo Error_In_CreateTable

I have stepped through the code as it is executing. The line is being run. I confirm column A has many rows of data.

Can you provide any guidance?

Thanks,

GL

 

[General Ledger]

shell_l_d,

I found the problem. It was with the data type of the variable iLastRow.

The original code defined the variable as an Integer, which accepts values between -32,768 and 32,767 If the number of rows exceeded 32,767, the variable always returned 0.

I changed the data type to Long, which accepts values between -2,147,483,648 to 2,147,483,647

Dim iLastCol As Integer, iLastRow As Long, iPos As Integer, iMaxWidth As Integer

GL

 

[shell_l_d]

Awesome bug finding, thanks guys