VBA Create and Rename Tables-CodePudding

I'm looking to create a table without selecting the first row and creating a table. Then naming the table based on what the sheet name is.

Sub ConvertDataToTables()
 
'  For i = 3 To 5
'    Sheets(i).Activate
'    Rows(1).EntireRow.Delete
'  Next i
  
  For i = 3 To 5
    On Error Resume Next
    Sheets(i).Select
    ActiveSheet.ShowAllData
    Cells.AutoFilter
    Range("A2").CurrentRegion.Select
    If ActiveSheet.ListObjects.Count < 1 Then
        ActiveSheet.ListObjects.Add.Name = ActiveSheet.Name
    End If
  Next i

Table names get place with an underscore with a space and I don't want that. so Sum Day = Sum_Day from my code. I also want to have the selection not choose the top row but everything below.

CodePudding user response：

Convert Table to Excel Table (`ListObject`)

Option Explicit

Sub ConvertDataToTables()
 
    Const FIRST_CELL As String = "A2"
    Const FIRST_INDEX As Long = 3
    Const LAST_INDEX As Long = 5
     
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim ws As Worksheet, rg As Range, fCell As Range, lo As ListObject
    Dim i As Long, NewName As String
    
    For i = FIRST_INDEX To LAST_INDEX
        
        Set ws = wb.Worksheets(i)
        
        If ws.ListObjects.Count = 0 Then

            ' Clear any filters (including an advanced filter).                
            If ws.FilterMode Then ws.ShowAllData
            ' Remove the auto filter.
            If ws.AutoFilterMode Then ws.AutoFilterMode = False
            
            NewName = Replace(Application.Proper(ws.Name), " ", "")
            ws.Name = NewName
            
            Set fCell = ws.Range(FIRST_CELL)
            With fCell.CurrentRegion
                Set rg = fCell.Resize(.Row   .Rows.Count - fCell.Row, _
                    .Column   .Columns.Count - fCell.Column)
            End With
            
            Set lo = ws.ListObjects.Add(xlSrcRange, rg, , xlYes)
            lo.Name = NewName
            
        End If
        
    Next i
    
End Sub

CodePudding user response：

Try the following code. It will replace spaces from the sheet names. Also, it doesn't use Select to rely on the ActiveSheet - for further reading refer to How to avoid using Select in Excel VBA

The code uses intermediate Range variables to define the range for the table. It starts at cell A2 (startCell) and uses the last cell of the CurrentRegion as endCell.

Dim sheetIndex As Long
For sheetIndex = 3 To ThisWorkbook.Worksheets.Count
    With ThisWorkbook.Worksheets(sheetIndex)
        If .ListObjects.Count = 0 Then
            Dim startcell As Range, endCell As Range, tableRange As Range
            Set startcell = .Cells(2, 1)
            Set endCell = startcell.CurrentRegion.Cells(startcell.CurrentRegion.Cells.Count)
            Set tableRange = .Range(startcell, endCell)
            Debug.Print tableRange.Address
            .ListObjects.Add(xlSrcRange, tableRange).Name = Replace(.Name, " ", "")
        End If
    End With
Next sheetIndex

Note that you should always use Option Explicit and declare all Variables and you should never use On Error Resume Next except for single statement where you know that they might fail (and you want to do the error handling by your own).

Convert Table to Excel Table (ListObject)

Convert Table to Excel Table (`ListObject`)