consolidating data in different worksheets

sayedbaharun · #1 (**permalink**) 02-08-05, 06:14

Hi Guys

I wondered if you can help me with the following problem?

I currently have 22 spreadsheets that come to me from the field formatted in exactly the same way. They are saved in a folder with their specific field name allocated.

What I need to do is collect all the data within the worksheets so I can have one topline number. This could be quite simple enough using the consolidation function however every worksheet will have a different amount of rows within it.

Is there a way I can build a macro that will collate all the data within the folder and workbooks and place it in one central point.

I have a little experience with VBA but this is beyond me.

Any help will be greatly appreciated

Regrds

DavidCoutts · #2 (**permalink**) 02-08-05, 10:37

Ive put this together very quickly for you hope its what you need

Code:

Sub test()
    Dim wkbCurrent As Workbook
    Dim wkbCopy As Workbook
    Dim wksCurrent As Worksheet
    Dim myLocn As String
    
    Set wkbCurrent = ActiveWorkbook
    Set wksCurrent = ActiveSheet
    
    myLocn = Application.GetOpenFilename
    myLocn = Mid(myLocn, 1, InStrRev(myLocn, "\"))
    With Application.FileSearch
            .LookIn = myLocn
            .SearchSubFolders = False
            If .Execute > 0 Then
                For i = 1 To .FoundFiles.Count
                    Set wkbCopy = Workbooks.Open(.FoundFiles(i))
                    Dim LstCell As Range
                    Set LstCell = Cells.Find("*", , , , , xlPrevious)
                    If Not LstCell Is Nothing Then
                        Range(Cells(2, 1), Cells(LstCell.Row, LstCell.Column)).Copy
                        wkbCurrent.Activate
                        wksCurrent.Cells(wksCurrent.UsedRange.Rows.Count + 1, 1).PasteSpecial
                    End If
                    wkbCopy.Close False
                Next i
            End If
    End With
    
    Set wkbCurrent = Nothing
    Set wkbCopy = Nothing
    Set wksCurrent = Nothing

End Sub

sayedbaharun · #3 (**permalink**) 02-08-05, 11:08

Hi David

Thank you for showing me how to do this. May I ask whether I copy the code for each of the spreadsheets?

Regards

Sayed

DavidCoutts · #4 (**permalink**) 02-08-05, 11:22

Just copy it into a module into 1 spreadsheet then you can run the code from there
if you go into the VBE (press Alt + F11 to do this) and then Insert-> Module this will open up a new module from which you can run this from

if you open up a worksheet with just your headings and then run the code (alt + F8 then choose the macro and click run) it should work as you want it

sayedbaharun · #5 (**permalink**) 02-08-05, 11:29

Hi David

Apologies for buging you again. I ran the code and I have got a funny error message which I havent seen before.

It says the following:

a day in the life of a dependant.doc:file format is not valid

ANy idea what this is?

DavidCoutts · #6 (**permalink**) 02-08-05, 11:37

its trying to open a word document as an excel spreadsheet

add this line

.FileType = msoFileTypeExcelWorkbooks
after
.SearchSubFolders = False

and that will force it only to look at excel workbooks

sayedbaharun · #7 (**permalink**) 02-09-05, 06:34

Hi David

This code now seems to be working up until its opening up the new file.

It is asking me which file it is I wan to open up then it goes into my documents folder and picks up a file from there. Im not sure how I get it to look t the right folder.

I have copied and pasted the code again with just the filepath change.

Sub Retrieve_Data()

Dim wkbCurrent As Workbook
Dim wkbCopy As Workbook
Dim wKScURRENT As Worksheet
Dim myLocn As String

Set wkbCurrent = ActiveWorkbook
Set wKScURRENT = ActiveSheet

myLocn = Application.GetOpenFilename
myLocn = Mid(myLocn, 1, InStrRev(myLocn, "G:\LP Analyst Figures\Arrest Figures\FY06\Download\central.xls"))
With Application.FileSearch
.LookIn = myLocn
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set wkbCopy = Workbooks.Open(.FoundFiles(i))
Dim LstCell As Range
Set LstCell = Cells.Find("*", , , , , xlPrevious)
If Not LstCell Is Nothing Then
Range(Cells(2, 1), Cells(LstCell.Row, LstCell.Column)).Copy
wkbCurrent.Activate
wKScURRENT.Cells(wKScURRENT.UsedRange.Rows.Count + 1, 1).PasteSpecial
End If
wkbCopy.Close False
Next i
End If
End With

Set wkbCurrent = Nothing
Set wkbCopy = Nothing
Set wKScURRENT = Nothing

End Sub

The folder path specified above is where all the individual workbooks are held.

The file where I would like it all copied to is the following: G:\LP Analyst Figures\Arrest Figures\FY06\Arrest Downlaod Sheet.xls

Am I able to do this?

DavidCoutts · #8 (**permalink**) 02-09-05, 07:36

if you put the code back the way it was what you need to do is go to the desired path when the open file dialog comes up pick a file and then run from there,

much easier than what i think your trying to do which you would need to change each time you had to look at a different folder path

it leaves the combined file open and unsaved to be stored where ever you like
Hope this makes sense
Dave