×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Import multiple excel Worksheet / workbook to a single table in Access 2010

Import multiple excel Worksheet / workbook to a single table in Access 2010

Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
This is a situation I recently encountered. My department has over 500 excel files with multiple tabs. We want to import the data from specific tabs into one excel database. These tabs will contain the same columns. I am not good with VBA and could not find a solution after much googling.

Also each excel file has an information tab from which I want to extract data from and populate with the data I am importing. This information file lists the date and location in separate cells.

I hope I am making sense here.

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

Hi,

We’ll try to get you started.

What specific tabs?

Do all these tabs have tables that have Headings that start in A1?

Are all 500 workbooks in one folder?

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)


There are 5 tabs out of the 9 I need in from there. Yes they all have headings that start in A1. Yes and all 500 files will be in one folder.

Thank you kindly for your help.

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

Great.

How about the information tab name?

What specific information needs to be captured and how is this data mapped to the output table?

How conversant are you with 1) Excel or 2) Excel VBA?

What languages do you program in?

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Great.

How about the information tab name?

Basically the users download this report from a larger reporting system. The information tab contains information like date of report and the name of the location.

Basically for each excel file I import into access, I would like to capture the date and location name from the information tab. This will sort of help identify the month and location of the date.

I am mediocre with Excel VBA.

My though process is to migrate the files firstly by combining all the excel files into one large excel file, then moving that to access. Please suggest a better way.

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

Well so far your answers have been nebulous. Maybe you just want some pointers. That will work just fine.

I agree with your approch.

I’d start by creating a new workbook for this conglomerate table. Set up the table headings.

In this worbook you will code this procedure, starting with a File System Object to use to loop through the single folder where your 500/files reside.

As you loop each file is opened.

You loop through each sheet in the open workbook capturing the DATA from the 5 sheets and pasting into the target workbook table, (the workbook containg your VBA code) in the next row of the table, and finally close the source workbook.

I’ll be available to help you with tips and other suggestions as requested. Good luck!

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

Please consider using TGML tags to format your code - an icon just above the box where you type your post/replies. Don't you agree this way is a lot easier to read....?

CODE --> example

' Correct number of sheets
 Application.DisplayAlerts = False

 If ThisWorkbook.Sheets.Count < NUMBER_OF_SHEETS Then
     ThisWorkbook.Sheets.Add Count:=NUMBER_OF_SHEETS - ThisWorkbook.Sheets.Count
 ElseIf ThisWorkbook.Sheets.Count > NUMBER_OF_SHEETS Then
     For i = ThisWorkbook.Sheets.Count To NUMBER_OF_SHEETS + 1 Step -1
         ThisWorkbook.Sheets(i).Delete
     Next i
 End If

 Application.DisplayAlerts = True 


---- Andy

There is a great need for a sarcasm font.

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

OOPS, Sorry blush
I corrected the Copy statement.

Here's an example of multiple sheet names for selective processing. This code also performs most of what you need, I believe...

CODE

Sub MAIN_COPY()
    Dim oFSO As Object, oFile As Object
    Dim ws As Worksheet, wsOUT As Worksheet
    Dim lRowOUT As Long, sFolderSpec As String
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
'put your OUTPUT workbook name here
    Set wsOUT = Worksheets("Name of your output table sheet")
'put the path to the INPUT file folders here
    sFolderSpec = "\\SKIPSPC\Users\Skip\Documents\TT"
    
    For Each oFile In oFSO.GetFolder(sFolderSpec).Files
        With Workbooks.Open(oFile.Path)
            For Each ws In .Worksheets
                With ws
                    Select Case .Name
'put your 5 worksheet names here
                        Case "Your", "5", "sheet", "names", "here"
                            Intersect(.Range(.Cells(2, 1), .Cells(.Cells.Rows.Count, 1)).EntireRow, .UsedRange).Copy
                    
                            With wsOUT
                                lRowOUT = .Cells(.Cells.Rows.Count, 1).End(xlUp) + 1
                                .Cells(lRowOUT, 1).PasteSpecial xlPasteValues
                            End With
                    End Select
                End With
            Next
            .Close
        End With
    Next
End Sub 

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Thanks for the code Skip.

I will try this when I get to work.

How would I add in another row and populate it with a value from a sheet from the file I am merging from?

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

Your questions and answers are very vague. What happens in vagueness, stays in vagueness. winky smile

You want to add a row and “populate it with a value from a sheet from the file I am merging from“?

Can you explain that because it doesn’t make sense to me.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Very sorry for the confusion. How exactly do I use the TGML tags? I clicked the TGML checkbox and it seems to be making no differece.

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
OK so the below code pasted should look better for the eyes

Now regarding the earlier point I am including an attachment to make things more clear. Just for privacy reason I have changed the labels and data drastically :)

The file is at http://files.engineering.com/getfile.aspx?folder=5...

When you open the file, you can see the different tabs that I want to merge (Medicines, Disasters, Rescues, Dentals) into one master sheet. The code below is doing that just fine.

Also I want to add three addition columns for every record (Date From, Date To, Service Delivery Agent). The value for this will come from the information tab from the respective cells.

Currently the code is adding an extra column (File Name) and adding the actual file name for it.

This is where I am stuck at.



CODE --> CODE

Option Explicit
Const NUMBER_OF_SHEETS = 7

Public Sub GiantMerge()
    Dim externWorkbookFilepath As Variant
    Dim externWorkbook As Workbook
    Dim i As Long
    Dim mainLastEnd(1 To NUMBER_OF_SHEETS) As Range
    Dim mainCurEnd As Range


    Application.ScreenUpdating = False

    ' Initialise

    ' Correct number of sheets
    Application.DisplayAlerts = False
    If ThisWorkbook.Sheets.Count < NUMBER_OF_SHEETS Then
        ThisWorkbook.Sheets.Add Count:=NUMBER_OF_SHEETS - ThisWorkbook.Sheets.Count
    ElseIf ThisWorkbook.Sheets.Count > NUMBER_OF_SHEETS Then
        For i = ThisWorkbook.Sheets.Count To NUMBER_OF_SHEETS + 1 Step -1
            ThisWorkbook.Sheets(i).Delete
        Next i
    End If
    Application.DisplayAlerts = True

    For i = 1 To NUMBER_OF_SHEETS
        Set mainLastEnd(i) = GetTrueEnd(ThisWorkbook.Sheets(i))
    Next i


    ' Load the data
    For Each externWorkbookFilepath In GetWorkbooks()
        Set externWorkbook = Application.Workbooks.Open(externWorkbookFilepath, , True)

        For i = 1 To NUMBER_OF_SHEETS

            If mainLastEnd(i).Row > 1 Then
                ' There is data in the sheet

                ' Copy new data (skip headings)
                externWorkbook.Sheets(i).Range("A2:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, 1)

                ' Find the end column and row
                Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i))
            Else
                ' No nata in sheet yet (prob very first run)

                ' Get correct sheet name from first file we check
                ThisWorkbook.Sheets(i).Name = externWorkbook.Sheets(i).Name

                ' Copy new data (with headings)
                externWorkbook.Sheets(i).Range("A1:" & GetTrueEnd(externWorkbook.Sheets(i)).Address).Copy ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row, 1)

                ' Find the end column and row
                Set mainCurEnd = GetTrueEnd(ThisWorkbook.Sheets(i)).Offset(, 1)

                ' Add file name heading
                ThisWorkbook.Sheets(i).Cells(1, mainCurEnd.Column).Value = "Date From"
            End If

            ' Add file name into extra column
            ThisWorkbook.Sheets(i).Range(ThisWorkbook.Sheets(i).Cells(mainLastEnd(i).Row + 1, mainCurEnd.Column), mainCurEnd).Value = externWorkbook.Name

            Set mainLastEnd(i) = mainCurEnd
        Next i

        externWorkbook.Close
    Next externWorkbookFilepath

    Application.ScreenUpdating = True
End Sub

' Returns a collection of file paths, or an empty collection if the user selects cancel
Private Function GetWorkbooks() As Collection
    Dim fileNames As Variant
    Dim xlFile As Variant

    Set GetWorkbooks = New Collection

    fileNames = Application.GetOpenFilename(Title:="Please choose the files to merge", _
                                               FileFilter:="Excel Files, *.xls;*.xlsx", _
                                               MultiSelect:=True)
    If TypeName(fileNames) = "Variant()" Then
        For Each xlFile In fileNames
            GetWorkbooks.Add xlFile
        Next xlFile
    End If
End Function

' Finds the true end of the table (excluding unused columns/rows and rows filled with 0's)
Private Function GetTrueEnd(ws As Worksheet) As Range
    Dim lastRow As Long
    Dim lastCol As Long
    Dim r As Long
    Dim c As Long

    On Error Resume Next
    lastCol = ws.UsedRange.Find("*", , , xlPart, xlByColumns, xlPrevious).Column
    lastRow = ws.UsedRange.Find("*", , , xlPart, xlByRows, xlPrevious).Row
    On Error GoTo 0

    If lastCol <> 0 And lastRow <> 0 Then

        ' look back through the last rows of the table, looking for a non-zero value
        For r = lastRow To 1 Step -1
            For c = 1 To lastCol
                If ws.Cells(r, c).Text <> "" Then
                    If ws.Cells(r, c).Text <> 0 Then
                        Set GetTrueEnd = ws.Cells(r, lastCol)
                        Exit Function
                    End If
                End If
            Next c
        Next r
    End If

    Set GetTrueEnd = ws.Cells(1, 1)
End Function 

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

FINALLY, looking at an example of your tables.

Empty rows in a table???!!!

Say it ain't so, Joe!

FAQ68-5184: What are LIST & TABLE PRINCIPLES for Spreadsheet Users

While you clean up your data and make your tables legal, I'm working on getting data from Information to your table.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

Hey, I’m coding a procedure to delete the empty rows. So don’t sweat that.

In the future, don't shoot yourself in the foot by inserting empty rows in any working table.

Excel features won’t work for you in such a table.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

This code example has the additional facility to copy the From:, To: and Agent: to the Output Table.

Included is the procedure to Delete empty rows.

And the three additional column headings are From:, To:, Agent: as in the sINFO array.

CODE

Sub MAIN()
'ShipVought 2018 APR 4
'loops thru a specified folder containing Excel source workbooks
'OPENS each source workbook
'Loops thru each source worksheet
'copies data from selected worksheets to output table
'stores selected data from Information sheet and propagates data in output table to all rows for source workbook
'closes source workbook
    Dim oFSO As Object, oFile As Object     'file system objects
    Dim ws As Worksheet                     'worksheet variable for source workbooks
    Dim wsOUT As Worksheet                  'output table worksheet
    Dim rINFO As Range                      'heading range for additional information columns
    Dim lRowOUT As Long                     'next row in output table
    Dim sFolderSpec As String               'your folder path
    Dim rFound As Range                     'range variable to find From:, To:, Agent:
    Dim sINFO(2, 1) As Variant              'array for data from Information
    Dim i As Integer                        'array index
    Dim iCOL As Integer                     'last column in output table
    
    sINFO(0, 0) = "From:"
    sINFO(1, 0) = "To:"
    sINFO(2, 0) = "Agent:"
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    Set wsOUT = Worksheets("Master")
'put your folder path here
    sFolderSpec = "\\SKIPSPC\Users\Skip\Documents\TT\Test"
    
    With wsOUT
        iCOL = .Cells(1, 1).End(xlToRight).Column
        Set rINFO = .Range(.Cells(1, iCOL - UBound(sINFO)), .Cells(1, iCOL))
    End With
    
    For Each oFile In oFSO.GetFolder(sFolderSpec).Files
        With Workbooks.Open(oFile.Path)
        
            'call macro to delete empty rows in source workbook
            DeleteEmptyRows .Sheets(1).Parent
            
            'loop through each sheet in source workbook
            For Each ws In .Worksheets
                With ws
                    Select Case .Name
                    
                        'only copy these sheets to output table
                        Case "Medicines", "Disasters", "Rescues", "Dentals"
                            Intersect(.Range(.Cells(2, 1), .Cells(.Cells.Rows.Count, 1)).EntireRow, .UsedRange).Copy

                            With wsOUT
                                lRowOUT = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row + 1
                                .Cells(lRowOUT, 1).PasteSpecial xlPasteAll
                            End With
                            
                        'fill array from Information
                        Case "Information"
                            For i = 0 To UBound(sINFO)
                                Set rFound = .Columns(1).Find(sINFO(i, 0))

                                If Not rFound Is Nothing Then
                                    sINFO(i, 1) = rFound.Offset(0, 1).Value
                                End If
                            Next
                    End Select
                End With
            Next
            
            'close the workbook without saving
            Application.DisplayAlerts = False
            .Close
            Application.DisplayAlerts = True
        End With
            
        'put the data from Information into output table
        With wsOUT
            lRowOUT = .Cells(.Cells.Rows.Count, iCOL).End(xlUp).Row + 1
            
            'put the values in the right-hand columns
            For i = 0 To UBound(sINFO)
                .Cells(lRowOUT, iCOL + i - UBound(sINFO)).Value = sINFO(i, 1)
            Next
            
            'copy the values down to the last row in the output table
            Intersect(rINFO.EntireColumn, .Rows(lRowOUT)).Copy _
            Intersect(rINFO.EntireColumn, _
                .Range(.Cells(lRowOUT, 1), .Cells(.UsedRange.Rows.Count, 1)).EntireRow)
        End With
    Next
End Sub

Sub DeleteEmptyRows(wb As Workbook)
    Dim ws As Worksheet

    For Each ws In wb.Worksheets
    
        'if the row count NOT EQUAL to a count of values in column 1 then we have empty rows
        If ws.UsedRange.Rows.Count <> Application.CountA(ws.Columns(1)) Then
        
            Select Case ws.Name
                Case "Information"
                Case Else
                    'delete empty rows for all sheets other than Information
                    With ws.UsedRange
                        .AutoFilter
                        .AutoFilter Field:=1, Criteria1:="="
                        Intersect(ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells.Rows.Count, 1)).EntireRow, .Cells).Delete xlUp
                        .AutoFilter
                    End With
            End Select
        End If
    Next
End Sub 

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Hi Skip.

' It says subsscript out of range when it comes to the following line.

Set oFSO = CreateObject("Scripting.FileSystemObject")

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Actually it stops at this line...

Set wsOUT = Worksheets("Master")

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

I don't know why. I just now ran my copy without error.

do you have a Sheet named Master in the workbook running this procedure where the output table resides?

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Your code is almost getting me there.

The thing that is not working are the three extra columns I need to capture from the information tab. Also it crashes when the folder has multiple files.

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Is there any way you can help me to modify the code I posted initally. I know it doesnt have the delete blanks function, I can figure that part out later.

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

Quote:

The thing that is not working are the three extra columns I need to capture from the information tab.

In the output table in the Master sheet you need three extra columns named From:, To: and Agent:

My procedure searches for those three values (in sINFO() array) in each workbook’s Information sheet and captures the values in the adjacent column that finally gets put and propagates in the last three columns of the output table.

I’ll upload the workbook I’m using. I also used your source workbook in my test folder.

Regarding helping you modify your code, I’ll answer general questions, but I’m not going to dig through your code to fix it. I gave you code that does what you requested and I can help you figure out what you need to do to make it work in your environment.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Thanks for your help thus far. I would appreciate seeing the workbook you are using.


RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

(OP)
Thank you that really helped. I was able to make it work. Basically I was placing the names of the three columns in the wrong place.

One more thing before I can close this thing off, is that is there a way to have another column with the Tab name the record is being pulled from?

For example if the data is being copied from the 'Medicines' tab, I would like to add in an extra column 'Category type' and populate it with 'Medicine'

RE: Import multiple excel Worksheet / workbook to a single table in Access 2010

So instead of three extra columns, you’d like four.

I’d put them in this order: Category type, From:, To:, Agent:

Tab name is Worksheet.Name. In the code, the Worksheet is in the For Each ws loop.

Assign the ws.Name after the data has been pasted into the output table, inside the With wsOUT. Use the technique like 'put the values in the right-hand columns, only this column is iCOL - 3.

Then use 'copy the values down to the last row in the output table as a template to propagate the value down to the last row of the table.

Let me know how that works for you.

Skip,

glassesJust traded in my OLD subtlety...
for a NUance!tongue

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close