<

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x

Collating worksheets from one or more workbooks into a summary file

Published on
41,370 Points
8,870 Views
45 Endorsements
Last Modified:
Awarded
Editor's Choice
Community Pick

Introduction

One of the more common requests in the online VBA forums is for code that will collate data into a single workbook. This code provides three options:
1) Collate all sheets from all Excel workbooks in a single folder into a single summary worksheet
2) Collate all sheets from all Excel workbooks in a single folder into a single summary workbook
3) Collate all sheets from a single Excel workbook into a single summary worksheet

I will now walk through several of the main code sections to explain their purpose, the full code is presented in it's entirety at the end of this article.
 

Understanding the code

1) Code scope
The code uses a Boolean InputBox to get the user to specify whether the code is to be applied to either all Excel WorkBooks in a specific directory (the default TRUE option), or whether the user wants to process a single file (FALSE option).
If bProcessFolder Then
    strFolderName = BrowseForFolder(strDefaultFolder)
    'Look for xls, xlsx, xlsm files
    strFileName = Dir(strFolderName & "\*.xls*")
Else
    strFileName = Application _
                  .GetOpenFilename("Select file to process (*.xls), *.xls")
End If

Open in new window



A second Boolean InputBox variable -  bNewSheet -  is used to store whether the code is to compile all the source worksheets into a single target worksheet (the default TRUE option), or whether each source worksheet should be copied to it's own target worksheet in the new workbook.

The code tests if the user wants to create an exact replica of a single file (FALSE for both Boolean Inputs) and exits if this is the case.

The directory option prompts the user to select a folder using the Shell object BrowseForFolder, whereas the single file option prompts the user to pick a particular file using GetOpenFileName.
 
If the user selected TRUE in step 1 then the code applies a  Do loop in combination with Dir to open all the *.xls* files in a specific directory for processing. The Dir approach is used as Microsoft has disabled the FileSearch method in xl2007, note that Dir does not provided an inbuilt sub folder option, so the code below would need to modified to call itself recursively if users wanted to apply the consolidation approach to all *.xls* files that sit in or under a specific directory.

The same code block is used to process a single file, if the user has selected this option then a Boolean variable is used to force the Do loop to exit after processing the file.

2) Managing the Excel environment
A single sheet workbook is created for the code output using a template.
Set Wb1 = Workbooks.Add(1)

Open in new window

The Application settings are then set to turn off screen updating and user alerts, to disable any automatic macros that may exist in the target file(s) and to store the user's current Calculation setting before setting Calculation mode to Manual.

'Turn off screenupdating, events, alerts and set calculation to manual
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End With

Open in new window


3) Source worksheet processing
The code tests each source worksheet to ensure that it is not empty. Empty sheets are skipped.

Depending on the user selections, the worksheets are either combined in a single sheet (Options 2 & 3), or a new target worksheet is created for each source worksheet

Part A: single sheet output

For the single sheet summary the code tests:
-  to find the real last row using Find (rather than assume the data is contiguous)
-  whether the remaining available row area in the target sheet will not be exceeded during the copy process
If bNewSheet Then
    'All data to a single sheet
    'Skip importing target sheet data if the source sheet is blank
    Set rng2 = ws2.Cells.Find("*", ws2.[a1], xlValues, , xlByRows, xlPrevious)

    If Not rng2 Is Nothing Then
        Set rng1 = ws1.Cells.Find("*", ws1.[a1], xlValues, , xlByRows, xlPrevious)
        'Find the first blank row on the target sheet
        If Not rng1 Is Nothing Then
            Set rng3 = ws2.Range(ws2.UsedRange.Cells(1), ws2.Cells(rng2.Row, "A"))
            'Ensure that the row area in the target sheet won't be exceeded
            If rng3.Rows.Count + rng1.Row < Rows.Count Then
                'Copy the data from the used range of each source sheet to the first blank row
                'of the target sheet, using the starting column address from the source sheet being copied
                ws2.UsedRange.Copy ws1.Cells(rng1.Row + 1 + lrowSpace, ws2.UsedRange.Cells(1).Column)
            Else
                MsgBox "Summary sheet size exceeded. Process stopped on " & vbNewLine & _
                       "sheet: " & ws2.Name & vbNewLine & "of" & vbNewLine & "workbook: " & Wb2.Name
                Wb2.Close False
                Exit Do
            End If
            'colour the first of any spacer rows
            If lrowSpace <> 0 Then ws1.Rows(rng1.Row + 1).Interior.Color = vbGreen
        Else
            'target sheet is empty so copy to first row
            ws2.UsedRange.Copy ws1.Cells(1, ws2.UsedRange.Cells(1).Column)
        End If
    End If

Open in new window


If the user has added a spacer row (using the lrowSpace variable) then this row is coloured green.
If lrowSpace <> 0 Then ws1.Rows(rng1.Row + 1).Interior.Color = vbGreen

Open in new window


Part B: multi-sheet output

With this approach each worksheet from each source workbook is copied to the summary workbook. Given there are multiple workbooks the code needs to test for duplicate worksheet names, and rename potential duplicate names with a unique name.
Else
    'new target sheet for each source sheet
    ws2.Copy after:=Wb1.Sheets(Wb1.Sheets.Count)
    'Remove any links in our target sheet
    With Wb1.Sheets(Wb1.Sheets.Count).Cells
        .Copy
        .PasteSpecial xlPasteValues
    End With
    On Error Resume Next
    Wb1.Sheets(Wb1.Sheets.Count).Name = ws2.Name
    'sheet name already exists in target workbook
    If Err.Number <> 0 Then
        'Add a number to the sheet name till a unique name is derived
        Do
            lSht = lSht + 1
            Set ws3 = Wb1.Sheets(ws2.Name & " " & lSht)
        Loop While Not ws3 Is Nothing
        lSht = 0
    End If
    On Error GoTo 0
End If

Open in new window


4) Tidying up

For the single target sheet option a simplecopy and paste special as values is used to remove any links on the target sheet.
If the user selected the mult-sheet target option then the summary worksheet is selected and formatted so that it is active when the code exits.
'Remove any links if the user has used a target sheet
    If bNewSheet Then
        With ws1.UsedRange
            .Copy
            .Cells(1).PasteSpecial xlPasteValues
            .Cells(1).Activate
        End With
    Else
        'Format the summary sheet if the user has created separate target sheets
        ws1.Activate
        ws1.Range("A1:B1").Font.Bold = True
        ws1.Columns.AutoFit
    End If

Open in new window


5) Reset the Excel environment
The Application settings are re-enabled, and Calculation is returned to it's pre code setting.
'Reset the Excel environment
    With Application
        .CutCopyMode = False
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = lngCalc
        .StatusBar = vbNullString
    End With

Open in new window


Full Code


Public Sub ConsolidateSheets()
    Dim Wb1 As Workbook
    Dim Wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rngArea As Range
    Dim lrowSpace As Long
    Dim lSht As Long
    Dim lngCalc As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim X()
    Dim bProcessFolder As Boolean
    Dim bNewSheet As Boolean

    Dim StrPrefix
    Dim strFileName As String
    Dim strFolderName As String

    'variant declaration needed for the Shell object to use a default directory
    Dim strDefaultFolder As Variant


 bProcessFolder = (MsgBox("Process a single folder (Yes)," & vbNewLine & "or single file (No)", vbYesNo, "Application Scope: Folder or single File") = vbYes)
    bNewSheet = (MsgBox("Extract all data to a single sheet (Yes)," & vbNewLine & "or a target file sheet for each source sheet (No)", vbYesNo, "Output Format: Single sheet or sheet by sheet collection") = vbYes)
    If Not bProcessFolder Then
        If Not bNewSheet Then
            MsgBox "There isn't much point creating a exact replica of your source file :)"
            Exit Sub
        End If
    End If

    'set default directory here if needed
    strDefaultFolder = "C:\temp"

    'If the user is collating all the sheets to a single target sheet then the row spacing
    'to distinguish between different sheets can be set here
    lrowSpace = 1

    If bProcessFolder Then
        strFolderName = BrowseForFolder(strDefaultFolder)
        'Look for xls, xlsx, xlsm files
        strFileName = Dir(strFolderName & "\*.xls*")
    Else
        strFileName = Application _
                      .GetOpenFilename("Select file to process (*.xls*), *.xls*")
    End If

    Set Wb1 = Workbooks.Add(1)
    Set ws1 = Wb1.Sheets(1)
    If Not bNewSheet Then ws1.Range("A1:B1") = Array("workbook name", "worksheet count")

    'Turn off screenupdating, events, alerts and set calculation to manual
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    'set path outside the loop
    StrPrefix = strFolderName & IIf(bProcessFolder, "\", vbNullString)

    Do While Len(strFileName) > 0
        'Provide progress status to user
        Application.StatusBar = Left("Processing " & strFolderName & "\" & strFileName, 255)
        'Open each workbook in the folder of interest
        Set Wb2 = Workbooks.Open(StrPrefix & strFileName)
        If Not bNewSheet Then
            'add summary details to first sheet
            ws1.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = Wb2.Name
            ws1.Cells(Rows.Count, "A").End(xlUp).Offset(0, 1) = Wb2.Sheets.Count
        End If
        For Each ws2 In Wb2.Sheets
            If bNewSheet Then
                'All data to a single sheet
                'Skip importing target sheet data if the source sheet is blank
                Set rng2 = ws2.Cells.Find("*", ws2.[a1], xlValues, , xlByRows, xlPrevious)

                If Not rng2 Is Nothing Then
                    Set rng1 = ws1.Cells.Find("*", ws1.[a1], xlValues, , xlByRows, xlPrevious)
                    'Find the first blank row on the target sheet
                    If Not rng1 Is Nothing Then
                        Set rng3 = ws2.Range(ws2.UsedRange.Cells(1), ws2.Cells(rng2.Row, "A"))
                        'Ensure that the row area in the target sheet won't be exceeded
                        If rng3.Rows.Count + rng1.Row < Rows.Count Then
                            'Copy the data from the used range of each source sheet to the first blank row
                            'of the target sheet, using the starting column address from the source sheet being copied
                            ws2.UsedRange.Copy ws1.Cells(rng1.Row + 1 + lrowSpace, ws2.UsedRange.Cells(1).Column)
                        Else
                            MsgBox "Summary sheet size exceeded. Process stopped on " & vbNewLine & _
                                   "sheet: " & ws2.Name & vbNewLine & "of" & vbNewLine & "workbook: " & Wb2.Name
                            Wb2.Close False
                            Exit Do
                        End If
                        'colour the first of any spacer rows
                        If lrowSpace <> 0 Then ws1.Rows(rng1.Row + 1).Interior.Color = vbGreen
                    Else
                        'target sheet is empty so copy to first row
                        ws2.UsedRange.Copy ws1.Cells(1, ws2.UsedRange.Cells(1).Column)
                    End If
                End If
            Else
                'new target sheet for each source sheet
                ws2.Copy after:=Wb1.Sheets(Wb1.Sheets.Count)
                'Remove any links in our target sheet
                With Wb1.Sheets(Wb1.Sheets.Count).Cells
                    .Copy
                    .PasteSpecial xlPasteValues
                End With
                On Error Resume Next
                Wb1.Sheets(Wb1.Sheets.Count).Name = ws2.Name
                'sheet name already exists in target workbook
                If Err.Number <> 0 Then
                    'Add a number to the sheet name till a unique name is derived
                    Do
                        lSht = lSht + 1
                        Set ws3 = Wb1.Sheets(ws2.Name & " " & lSht)
                    Loop While Not ws3 Is Nothing
                    lSht = 0
                End If
                On Error GoTo 0
            End If
        Next ws2
        'Close the opened workbook
        Wb2.Close False
        'Check whether to force a DO loop exit if processing a single file
        If bProcessFolder = False Then Exit Do
        strFileName = Dir
    Loop

    'Remove any links if the user has used a target sheet
    If bNewSheet Then
        With ws1.UsedRange
            .Copy
            .Cells(1).PasteSpecial xlPasteValues
            .Cells(1).Activate
        End With
    Else
        'Format the summary sheet if the user has created separate target sheets
        ws1.Activate
        ws1.Range("A1:B1").Font.Bold = True
        ws1.Columns.AutoFit
    End If

    With Application
        .CutCopyMode = False
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = lngCalc
        .StatusBar = vbNullString
    End With
End Sub


Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'From Ken Puls as used in his vbaexpress.com article
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=284

    Dim ShellApp As Object
    'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
                   BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    'Destroy the Shell Application
    Set ShellApp = Nothing

    'Check for invalid or non-entries and send to the Invalid error
    'handler if found
    'Valid selections can begin L: (where L is a letter) or
    '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

Invalid:
    'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

Open in new window

 

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
If you liked this article and want to see more from this author, please click here.

If you found this article helpful, please click the Yes button near the:

      Was this article helpful?

label that is just below and to the right of this text.   Thanks!
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
45
Comment
Author:Dave
29 Comments
LVL 93

Expert Comment

by:Patrick Matthews
Dave,

Another superb article in a long string of great Excel pieces!

I had this concept on my list of future article topics, but I can cross that off now as there is now way I could have covered the topic as well as you did.

Cheers,

Patrick
0
LVL 50

Author Comment

by:Dave
Thanks Patrick for the kind words :)

I have left the back door open for a recursive Dir process to be added to this routine to process files in subfolders. I have been using a public variable array approach that you recently posted for this - I think this would be a useful article to combine with this one

Cheers

Dave

0

Expert Comment

by:hendrkle
This is great, thank you for taking the time to share this!

I'm just wondering if it could be amended to copy only data from a particular sheet in the other workbooks, say only the 1st or last sheet, or only the sheet with name x?

Cheers

Hendrik
0
Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

LVL 50

Author Comment

by:Dave
Thanks for the compliment and helpful vote

The code currently loops through all worksheets using a For ... Next loop with a ws2 variable

For your three discrete sheet settings you would
1) Replace this code line
For Each ws2 In Wb2.Sheets
with either
a) Set ws2 = Wb2.Sheets(1)
b) Set ws2 = Wb2.Sheets(Sheets.Count)
c) Set ws2 = Wb2.Sheets("x")
2) Delete this code line to remove the loop
     Next ws2

Cheers
Dave

0
LVL 2

Expert Comment

by:Jeffrey Smith
Dave,

Thanks for posting a great article and a useful tool that will definitely go in my toolbox!

Jeff
0
LVL 50

Author Comment

by:Dave
Thanks to you too Jeff for the vote and kind comment :)

I'm glad you found it useful

Regards

Dave
0

Expert Comment

by:cnv3410
Dave,

Great article that has saved me some significat time trying to figure out how to do this.  A couple questions:

How can I prevent the header row from being copied every time?  I have played with the code a little and can't seem to find where to set the range at row 2 instead of row 1.
Is there a way to specify the copy step into an existing workbook?

Thanks
Nick

0
LVL 50

Author Comment

by:Dave
Nick,

Thanks for the kind comments and vote.

(1)
The easiest way to kill a header row would be to delete the first row of the summary sheet on each copy - rather than resize the usedrange each time of the sheet to be copied.

I have added a single line below to do this
    ws1.Cells(rng1.Row + 1 + lrowSpace, "A").EntireRow.Delete

If you wanted to keep the header row from the first sheet then use
   If ws2.Index > 1 Then ws1.Cells(rng1.Row + 1 + lrowSpace, "A").EntireRow.Delete

(2)

Yes

You would edit this line
Set Wb1 = Workbooks.Add(1)

to either refer to an existing open workbook, or to open an existing closed summary workbook

Do you need further guidance on this?

Cheers

Dave
If rng3.Rows.Count + rng1.Row < Rows.Count Then
                            'Copy the data from the used range of each source sheet to the first blank row
                            'of the target sheet, using the starting column address from the source sheet being copied
                            ws2.UsedRange.Copy ws1.Cells(rng1.Row + 1 + lrowSpace, ws2.UsedRange.Cells(1).Column)
                            ws1.Cells(rng1.Row + 1 + lrowSpace, "A").EntireRow.Delete
                        Else
                            MsgBox "Summary sheet size exceeded. Process stopped on " & vbNewLine & _
                                   "sheet: " & ws2.Name & vbNewLine & "of" & vbNewLine & "workbook: " & Wb2.Name
                            Wb2.Close False
                            Exit Do
                        End If

Open in new window

0

Expert Comment

by:cnv3410
Dave,

Worked like a charm.  This is exactly what I need.

Thanks again.

Nick
0

Expert Comment

by:cnv3410
Dave,

Another quick question, as my requirements just changed.  Is there a way to look at a particular column for data and where the values end in that column is the end of the range to copy.  I am aggregating templates that have some standard information pre-populated so there will be more rows that needed for each.  There is a column that the user will input data, and the last row of data in this input column marks the end fo the range regardless of how many pre-populated rows remain.

Thanks
Nick
0
 

Administrative Comment

by:Kevin Cross
brettdj:

It is with great honor that I annouce that your article was not only nominated for the Editor's Choice award, but that it was also successfully voted as such.

Congratulations!

You have a number of BIG yes votes above from the page editors. Keep up the good work!!

Respectfully yours,

mwvisa1
EE Page Editor
0
LVL 39

Expert Comment

by:nutsch
Good job Dave.

Thomas
0

Expert Comment

by:zoomer003
Hey Dave Great article .. it jus im very new to macros and other programming language ... i kind of need to write a macro very close to yours. but the thing is instead of formatting i have to get the average and st.deviation of colum I, L,M,N and P each contain 61 rows. and copy the data to a summary file. how can i do that?
0
LVL 4

Expert Comment

by:Jorgen
Hey Dave,

The suggestions you have given on different type of collecting the sheets works fine.

But I have a different situation.  I need everytime to put sheet 1 for all worksheets into workbook 1(which is placed in another directory), and close that, and then put all sheet 2 for all worksheets into workbook 2 etc.

I saw your suggestion for taking just 1 sheet from each workbook, which means that I can create my workbooks semi automated, but not fully, which would be preferred.

Is there also a clever solution for that?

Best regards

Jørgen
0
LVL 50

Author Comment

by:Dave
Hi Jorgem,

Sorry, I'd missed your question

If this is still an issue then I can post an upate for you

Regards

Dave
0

Expert Comment

by:mreid3847
Great article Dave.  I am new to working with Excel, macros and VBA but I read your article and followed it for the most part.  Thank you for writing so clearly. However I have a question posted ID: 26940553 and I am totally stuck.  

I attempted to modify a copy of the code from your article as you suggested to hendrkle around the ws2 variable.  I was met with limited success it that it did copy but not all information.  I do not know enough about Excel to know if I am dealing with an issue with the way the files are formated or something else with the data files that I need to process.  The data files I have were passed to me by management.

Regards
Misty
0
LVL 50

Author Comment

by:Dave
Thanks Misty :)

It be easier to progress your problem if you post a queestion (including sample files) in the Excel TA, http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/

Cheers

Dave

0

Expert Comment

by:BEBaldauf
Thanks so much for the great code!  I have run into an issue I hope you can assist with as I implement this code.  The ranges being copied are formattted as Tables.  They each get pasted as tables into the new worksheet.  But the table range is not re-sized, and I cannot manually resize it to include all the data on the new worksheet because it would create overlapping tables.  Is there a way to remove the table formatting, or convert each range to a normal range, as they are combined?
Any help much appreciated!
Bethyn
0
LVL 81

Expert Comment

by:byundt
An Asker tried to use this code in http:/Q_27440170.html to add worksheets to a composite workbook, only to encounter a run-time error with the first file being added. Upon investigation, there were hidden columns and filtered rows that caused a problem with Cells.Copy followed by PasteSpecial xlPasteValues. As a workaround, I iterated through the areas in the SpecialCells(xlCellTypeVisible) collection, replacing the formula with the value (Copy and PasteSpecial weren't working even on an area by area basis).

This same Asker then decided to append worksheets by the same name to a composite worksheet. Although a green highlight separates the data from each file, the Asker wanted the name of the source workbook to indicate where the data came from. I did so in column A, in essence "normalizing" the data.

The revised code for each issue is posted in the referenced thread.

Brad
0
LVL 42

Expert Comment

by:dlmille
Dave - nice piece of work.  I probably should have gone here first, on several occassions, but banged out my own version of things which work great as a learning experience.  In a recent post http:/Q_27501782.html, however, your solution won out, but a couple issues were teed up, then resolved to the OP's satisfaction.  
-------------------------------------------------------
This is a really good app, and I've identified what I think (unless I'm looking cross-sighted) are a couple minor issues you'd appreciate addressing:

To test this solution, I created one input file with several sheets of one column * 65K rows, then saved as an Excel 2003 .XLS file.  This particular case creates a couple errors that I think can be easily addressed.

First - There's a line in the code to ensure the app doesn't exceed maximum rows:

LINE 91:  If rng3.Rows.Count + rng1.Row < Rows.Count Then

The problem with this line is Rows.Count is referencing the SOURCE sheet, as opposed to the DESTINATION sheet.  When the SOURCE sheet is Excel 2007+, the limit is 1MM rows, when its not, the limit is 65K rows.  I believe the line should be re-written as:

LINE 91:  If rng3.Rows.Count + rng1.Row < ws1.Rows.Count Then

Recall ws1 points to the sheet object of the DESTINATION sheet.

Second, if the source sheet has used every row, then the app will generate (LINE 94) a runtime 1004 error:   "The information cannot be pasted because the Copy area and the paste area are not the same size and shape..."

While a unique circumstance (using EVERY ROW), its actually what I did to set up a test case so I could ascertain the problem the OP was having with the "Sheet size exceeded" error trap.  While the first solution (above) got me past that part, having used every row generated the additional error.  If I had generated at least one row less, I would never have noticed the problem.

I scratched my head on this one a while.  The only thing I can think of is to check if the UsedRange.Rows.Count = the sheet's Rows.Count and if so, to copy one row less, then go back and get that row in a second pass...

Not a big issue, but if the source worksheet has any formatting in rows below "real data", those rows go with the Used Range.  Same for columns.

Regardless - voted "Yes" and will start with this post now that I've had a chance to decipher the code, while assisting an OP.

Dave
0
LVL 50

Author Comment

by:Dave
Thx Dave,

When I get some time I will go through your detailed comments. My immediate thoughts are that the Rows.Count issue is fine as is given the code works inside a single Excel instance, ie the rows in source and destination workbooks are indentical. But will look at this further over the weekend :)

Regards

Dave B
0

Expert Comment

by:bvanscoy678
Dave,

Very helpful article! Thank you for taking the time to publish it. Your articles are becoming a staple in my bookmark folder!

Again Thanks,
Brent
0

Expert Comment

by:hvanderw
Hi Dave,

Excellent resource!
Is there any way to eliminate the first two questions and just ask for the folder? It would be nice to save the two clicks because the same thing would be used every time. I have modified your code just a bit to find and remove all 0.00 balance fields after it runs, but to get rid of the first two prompts would be a nice time saver. I would only like the single folder single sheet option and just pick a folder. Would that be possible?
Thanks!
0
LVL 50

Author Comment

by:Dave
Thanks hvanderw :)

Just comment out

bProcessFolder = (MsgBox("Process a single folder (Yes)," & vbNewLine & "or single file (No)", vbYesNo, "Application Scope: Folder or single File") = vbYes)
    bNewSheet = (MsgBox("Extract all data to a single sheet (Yes)," & vbNewLine & "or a target file sheet for each source sheet (No)", vbYesNo, "Output Format: Single sheet or sheet by sheet collection") = vbYes)  

Open in new window

and replace with
bProcessFolder = True
    bNewSheet = True

Open in new window

 
Regards
Dave
0

Expert Comment

by:J_Drake
Hi Dave,

Nice article..  How would I modify to only pull out a single table "machine parts"; table may span multiple tabs?

Regards,
JD
0

Expert Comment

by:crownterm
Hi Dave,
I'm from Malaysia,

Great Article... I want to use the macro for my raw data arrangement,
my raw data is in many .xls files, all in

A1 ........ Blank
A(Blank) --------- Blank

I need to arrange each column in different sheets in 1 .xls file, like this

data (sheet1)             data (sheet2)          untill blank...
column A                    column B              untill blank...


regards
crownterm
0
LVL 1

Expert Comment

by:Alex Campbell
Great article, but I was wondering what this piece was after the full code:

If bProcessFolder Then
    strFolderName = BrowseForFolder(strDefaultFolder)
    'Look for xls, xlsx, xlsm files
    strFileName = Dir(strFolderName & "\*.xls*")
Else
    strFileName = Application _
                  .GetOpenFilename("Select file to process (*.xls), *.xls")
End If

Open in new window

0

Expert Comment

by:ACBITS
Hi Dave,

Brilliant article which has saved loads of time. I'm very new to VBA and found this extremely useful.  

Is it possible to amend and identify when the first row of each file do not match?  i.e. someone has inserted / or moved / deleted a column?

maybe just bring back the first row of each worksheet and put onto another summary sheet and identify if not exact match ?

Thanks very much.
Cliff
0

Expert Comment

by:Member_2_7966736
Hi Dave,

Excellent article.

I tried to implement your sugestion:

If you wanted to keep the header row from the first sheet then use
   If ws2.Index > 1 Then ws1.Cells(rng1.Row + 1 + lrowSpace, "A").EntireRow.Delete

It didn't work for me. Is there any other solution?

Thank you very much.

Regards

Celio
0

Featured Post

Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Join & Write a Comment

This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month