Create Table with VBA

Hi,  I have code to delete the current data that is in a table and repopulate from an updated file, however it takes 30 plus minutes for the file to requery.  I found code to make the VBA run more efficiently, but now the data is not populated into a table, which is impacting data on other sheets that uses functions calling to the table name.

Is it possible to adjust the code to place the data into a table?  Below is the code

Sub CopySourceData()
    Dim wb As Workbook
    Dim fso As FileSystemObject
    Dim myFolder As Folder
    Dim myFile As File
    Dim newestFile As File
    Dim ws As Worksheet
    Set fso = New FileSystemObject
    'For test purposes, I am using the "My Documents" folder... this needs to change
    ' To use whatever folder you need
    With Sheets("ISS")
    End With
    Set myFolder = fso.GetFolder("\\SSFilePrint\GROUPSHARE\Store Planning\Projects\International\Store Schedules\JDE Store report")
    '\\SSFilePrint\GROUPSHARE\Store Planning\Projects\International\Store Schedules\JDE Store report
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each myFile In myFolder.Files
        Select Case UCase(fso.GetExtensionName(myFile.Path))
            Case "XLS", "XLSM", "XLSB", "XLSX":
                If newestFile Is Nothing Then
                    Set newestFile = myFile
                ElseIf myFile.DateLastModified > newestFile.DateLastModified Then
                    Set newestFile = myFile
                End If
        End Select
    'At this point... "newestFile" is a File object that is the newest Excel File in your folder
    ' The following code will open it, and now you have to copy from whatever range you need data from
    If Not newestFile Is Nothing Then
        Application.Workbooks.Open newestFile.Path
        Set wb = Application.Workbooks(newestFile.Name)
    'or if you now the name of the sheet it could be something like : Set ws = wb.Sheets("Sheet1")
        Set ws = wb.Sheets(1)
     Set lastSourceCell = LastCell(ws)
        If lastSourceCell Is Nothing Then
            MsgBox "Nothing to copy - stopping"
            Exit Sub
        End If
        Set lastDestCell = LastCell(ThisWorkbook.Sheets("ISS"))
        If lastDestCell Is Nothing Then
            destinationRow = 1
            destinationRow = lastDestCell.Row + 1
        End If
        For I = 2 To lastSourceCell.Row
            If ws.Range("A" & I).Value = "BEAUTY & ACCESSORIES" Then
                ws.Range("A" & I).EntireRow.Copy
                ThisWorkbook.Sheets("ISS").Range("A" & destinationRow).PasteSpecial xlPasteAll
                destinationRow = destinationRow + 1
            End If
        Application.ScreenUpdating = True
        Application.DisplayAlerts = False
        MsgBox "Copy Complete"

    End If

'Sub ConvertTextNumberToNumber() ' Changes store number from text to a number
    For Each ws In Sheets
        On Error Resume Next
        For Each n In ws.UsedRange.SpecialCells(xlCellTypeConstants)
        If IsNumeric(n) Then n.Value = Val(n.Value)
 Sheets("ISS").Range("F1").Value = Date
 Application.Calculation = xlCalculationAutomatic
End Sub

Open in new window

Who is Participating?
Jerry PaladinoConnect With a Mentor Commented:
If you are leaving the table header and executing the command I gave you I suspect you may be getting an error that says "1004 - A table cannot overlap another table".  If so, that is happening because you still have the original table (the Header row) and you are trying to create a new table on top of that one.

Since Excel Tables are ListObjects, you can "Unlist" your table and make it a plain list before you make the new table.   You must know the name of the original table so you can execute the unlist.  I am making the assumption below that the table is named "Tbl_IssData".    Place the cursor on the header row, unlist the table and then recreate it with the same name.

    Sheets("ISS").ListObjects.Add(xlSrcRange, , , xlYes).Name = "Tbl_IssDate"
Martin LissOlder than dirtCommented:
Can you supply a test file?
Jerry PaladinoCommented:
I believe you are writing your new data list to Sheets("ISS").   Once your loop has completed and the data is written to that sheet you can convert it to an EXCEL TABLE with:

Sheets("ISS").ListObjects.Add(xlSrcRange, , , xlYes).Name = "Tbl_IssDate"

This converts the data list to an EXCEL TABLE and sets the name of the Table to Tbl_IssData.  Change it to whatever name you prefer.

The cursor must be within the data area before this command is executed.  If your table does not start in the first row make sure you select a cell within the data area before the above command is executed.

jmac001Author Commented:
Hi Jerry,

Not sure how to proceed, the code works in my test file, but when I try to execute in my live file the table does not create completely.  Does it make a difference if the table already exists, when the delete statement is executed it deleting all of the data with the header row remaining and leaves row A4 in table format.  Row A4 is the only data that is in table once the macro is fully executed.
jmac001Author Commented:
Thanks is working now, just had to find the correct placement in the code for it to work and update the table name correctly.  Added:


to the beginning of the code and towards the bottom

 Sheets("ISS").ListObjects.Add(xlSrcRange, , , xlYes).Name = "ISS"
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.