Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 416
  • Last Modified:

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")
        Rows("4:65536").Select
        Selection.Delete
        Range("A4").Select
    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
    Next
    
    '--------------------------------------------------------------------------------
    '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"
            wb.Close
            Exit Sub
        End If
        
        Set lastDestCell = LastCell(ThisWorkbook.Sheets("ISS"))
        If lastDestCell Is Nothing Then
            destinationRow = 1
        Else
            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
        Next
        Application.ScreenUpdating = True
        Application.DisplayAlerts = False
        wb.Close
        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)
        
       Next
 
   Next
    
 Sheets("ISS").Range("F1").Value = Date
 Application.Calculation = xlCalculationAutomatic
End Sub

Open in new window

0
jmac001
Asked:
jmac001
  • 2
  • 2
1 Solution
 
Martin LissRetired ProgrammerCommented:
Can you supply a test file?
0
 
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.

HTH
Jerry
0
 
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.
0
 
Jerry PaladinoCommented:
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").Range("A4").Activate
    Sheets("ISS").ListObjects("Tbl_IssDate").Unlist
    Sheets("ISS").ListObjects.Add(xlSrcRange, , , xlYes).Name = "Tbl_IssDate"
0
 
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:

   Sheets("ISS").Range("A4").Activate
   Sheets("ISS").ListObjects("ISS").Unlist

to the beginning of the code and towards the bottom

   Sheets("ISS").Range("A4").Activate
 Sheets("ISS").ListObjects.Add(xlSrcRange, , , xlYes).Name = "ISS"
0

Featured Post

[Webinar] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now