Solved

Create Table with VBA

Posted on 2013-12-18
5
373 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 47

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

SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

726 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