Solved

Create Table with VBA

Posted on 2013-12-18
5
329 Views
Last Modified: 2013-12-23
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
Comment
Question by:jmac001
  • 2
  • 2
5 Comments
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39728030
Can you supply a test file?
0
 
LVL 16

Expert Comment

by:Jerry Paladino
ID: 39728833
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
 

Author Comment

by:jmac001
ID: 39730513
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
 
LVL 16

Accepted Solution

by:
Jerry Paladino earned 500 total points
ID: 39730741
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
 

Author Closing Comment

by:jmac001
ID: 39736619
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

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now