VBA script for collation of data

Hi guys :
I've been working on a requirement that involves, collating data from multiple sales reps and consolidating them into one file. Once this collation is done, we would be using this worksheet to generate reports . This is required on a monthly basis
I managed to find some code on the web , that helps me collate the data, but need help in these two aspects :
1) I'm able to collate the data from multiple sheets (it is appended in the same worksheet), but i loose the header in the master sheet. The header will be in the same lines as
Sl No Sales Rep Customer Product Month Unit Price Qty
How can i ensure that the master has this header and the collation of data starts after their headers.

2) On running of the macro, all files open up and remains open after the data is collected on the master. How can i close the sheets after the master has been populated with data.

3) Since the data is collected from multiple sheets, each users data have their line items numbered, but in the master sheet, we find that the numbering (Sl no) is not consistnt. How can i have a sequential numbering in column A for all data.

Would appreciate any inputs , pointers in this regard...

TIA.

Sushesh

The code that i use is :

Sub Get_Value_From_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng   As Range
    Dim rNextCl As Range
    Dim lCount As Long
     
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
         
        On Error Resume Next
         
        Set wbThis = ThisWorkbook
         'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        uRng.Offset(1, 0).Resize(uRng.Rows.Count - 1, _
        uRng.Columns.Count).Clear
        With .FileSearch
            .NewSearch
             'Change path to suit
            .LookIn = "C:\Test"
            .FileType = msoFileTypeExcelWorkbooks
             
            If .Execute > 0 Then 'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count ' Loop through all.
                     'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    Set rToCopy = wbSource.Worksheets(1).UsedRange
                    Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
                    rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                    rToCopy.Columns.Count).Copy rNextCl
                  
                    
                Next lCount
            Else:  MsgBox "No workbooks found"
            End If
        End With
         
         
        On Error GoTo 0
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

The example code that you have used copies data from several workbooks to one. It starts by clearing the data that exists in the master sheet, leaving header rows, it then copies the data without header rows. So if you have no data in the sheet the first copy must import the header rows. Do this by checking for data in the master sheet & setting a Boolean variable. The following cod should work but I haven't tested it.

Option Explicit

Sub Get_Value_From_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng   As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False

        On Error Resume Next

        Set wbThis = ThisWorkbook
        'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        If uRng.Cells.Count <= 1 Then
            'no data in master sheet
            bHeaders = False
            GoTo search
        End If
        uRng.Offset(1, 0).Resize(uRng.Rows.Count - 1, _
                                 uRng.Columns.Count).Clear
search:
        With .FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "C:\Test"
            .FileType = msoFileTypeExcelWorkbooks

            If .Execute > 0 Then    'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count    ' Loop through all.
                    'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    Set rToCopy = wbSource.Worksheets(1).UsedRange
                    Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
                    If bHeaders Then
                        'headers exist so don't copy
                        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                    rToCopy.Columns.Count).Copy rNextCl
                        'no headers so copy
                    Else: rToCopy.Copy rNextCl
                        bHeaders = True
                        End If
                    Next lCount
                Else: MsgBox "No workbooks found"
                End If
            End With


            On Error GoTo 0
            .ScreenUpdating = True
            .DisplayAlerts = True
            .EnableEvents = True
        End With
 End Sub

Your second question should be in a separate thread! However, if you use a formula to set the sequential numbering in each workbook based on the ROW() function, this would update when the new workbook calculates.

Try this

Option Explicit

Sub Get_Value_From_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng   As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False

        On Error Resume Next

        Set wbThis = ThisWorkbook
        'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        If uRng.Cells.Count <= 1 Then
            'no data in master sheet
            bHeaders = False
            GoTo search
        End If
        uRng.Offset(1, 0).Resize(uRng.Rows.Count - 1, _
                                 uRng.Columns.Count).Clear
search:
        With .FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "C:\Test"
            .FileType = msoFileTypeExcelWorkbooks

            If .Execute > 0 Then    'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count    ' Loop through all.
                    'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    Set rToCopy = wbSource.Worksheets(1).UsedRange
                    Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)
                    If bHeaders Then
                        'headers exist so don't copy
                        rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                    rToCopy.Columns.Count).Copy rNextCl
                        'no headers so copy
                        'place headers in Row 2
                    Else: rToCopy.Copy Cells(2, 1)
                        bHeaders = True
                    End If
                    wbSource.Close False     'close source workbook
                Next lCount
            Else: MsgBox "No workbooks found"
            End If
        End With


        On Error GoTo 0
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

If you try to follow the code you will see that this line skips a row

 Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(2, 0)

So change it to

 Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

You can zip the4 files together then use www.yousendit.com, post the download link here

I cannot open any of these files .

I'm looking at it now

The code works exactly as I expect. You haven't placed the master workbook in the same folder as the data workbooks?

This is the code that I have ended up with

Option Explicit

Sub Get_Value_From_All()
    Dim wbSource As Workbook
    Dim wbThis As Workbook
    Dim rToCopy As Range
    Dim uRng   As Range
    Dim rNextCl As Range
    Dim lCount As Long
    Dim bHeaders As Boolean

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False

        On Error Resume Next

        Set wbThis = ThisWorkbook
        'clear the range except  headers
        Set uRng = wbThis.Worksheets(1).UsedRange
        If Application.WorksheetFunction.CountA(uRng) = 0 Then
            'no data in master sheet
            bHeaders = False
        End If
        With .FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "C:\Test"
            .FileType = msoFileTypeExcelWorkbooks

            If .Execute > 0 Then    'Workbooks in folder
                For lCount = 1 To .FoundFiles.Count   ' Loop through all.
                    'Open Workbook x and Set a Workbook  variable to it
                    Set wbSource = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                    Set rToCopy = wbSource.Worksheets(1).UsedRange
                    Set rNextCl = wbThis.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                        If bHeaders Then
                        'headers exist so don't copy headers
                        Set rToCopy = rToCopy.Offset(1, 0).Resize(rToCopy.Rows.Count - 1, _
                                                                  rToCopy.Columns.Count)
                    End If
                    rToCopy.Copy rNextCl
                    wbSource.Close False     'close source workbook
                    bHeaders = True
                Next lCount
            Else: MsgBox "No workbooks found"
            End If
        End With


        On Error GoTo 0
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With
End Sub

The master file should not be in the same file as the data files.

The code that I posted last copies all the data for me with only one header row.

I couldn't open your files so I created my own, just 3 files with the same layout containing different data.

I am relatively new to writing macros, and have been developing a macro to collate some data sets. In searching for people working on similar macros, I came across your proposed solution above, and have had some success modifying it to overcome the trivial issues, unique to my data set (i.e. 2 row header, etc.).

What I am looking to achieve with the macro I'm working on is to only copy particular columns from each data set, and I have been having some problems. When modifying the code provided above to copy a defined range (i.e. Range("B:C,G:G,I:I,L:O"), as opposed to all the data (usedrange), I am finding the macro only copies data from the first file. The macro loops through all of the available files, but does not copy anything beyond the first set. I'm not sure if there is something inherent in the "usedrange" property that makes this macro work, or if I'm just overlooking another issue. I have exhausted my knowledge of macros to this point, and decided to come back to the source to see if you had any expertise/suggestions you could share.

Is modifying this macro the way to go, or should I be starting from a different direction!?

Please ask your own question, with a link to this one. This is covered in the Forum Rules.