Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Linking Specific Sheets to One Master Excel

Status
Not open for further replies.

PHV

MIS
Nov 8, 2002
53,708
FR
Have you tried to use MS-Query ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
BTW, have a look here:
faq68-5829

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
That sounds like a good plan, but I can't seem to find it. I am using Microsoft 10. Is there an add-in in excel or do I need to buy the program? Thanks.
 
I have this in my personal macros folder which I have not used far a really long time, but sounds as though it could be adapted for your use? you would probably only really be changing the locations and the contents of the "Update" and "Overwrite" subs. There is a lot which I'm sure you can just delete, but I thnk the bare bones way help you..? This macro is designed to take data from a defined location within a large number of files and load it into one target file, in a summary sheet.

Code:
Option Explicit
    Dim scrFso As Object 'a FileSystemObject which will be set with scripting
    Dim oFolder As Object 'the folder object
    Dim oContentFolders As Object 'the subfolders contained in the oFolder
    Dim oFile As Object 'the file object
    Dim oFiles As Object 'the files object
    Dim strMonth, strYear As String 'the number of the month and year in which we are at the moment
    Dim i As Integer 'a counter
    Dim WbTarget As Workbook 'Where everything will go
    Dim StrName As String 'the name of each file as we open it
    Dim Wkbk As Workbook
    Dim rFound, rTotals As Range
    Dim YNOverwrite As Boolean 'user answer about whether to overwrite files
    Dim strRoot As String 'Where we get the files from
    
Sub OpenAllFilesInFolder()
     
     'stop the screen flickering
    Application.ScreenUpdating = False

    i = 0
    'Given that the workbook will be open if you are running this macro, set it as the target for the collated data
    Set WbTarget = ActiveWorkbook
    'Set WbTarget = Workbooks.Open(Filename:="P:\Docs\Mark Griffiths\Worksheets.xlsx")
    strRoot = "P:\Docs\WORKSHEETS"
'ask the user if they want to add to the current list or replace it
If MsgBox("Do you wish to overwrite the entire file? Clicking NO will update for this month only", vbYesNo, "Collate Worksheets to File") = vbYes Then
        YNOverwrite = True
Else
        YNOverwrite = False
End If

'If the user wishes to add to the data, record the current month and year so we can add only latest data
strMonth = CStr(Month(CDate(Now)))
strYear = CStr(Year(CDate(Now)))
'the month number should be two digit
If Len(strMonth) < 2 Then strMonth = "0" & strMonth

    'search the subfolders for Excel Files
    SearchContents strRoot
    'turn updating back on
    Application.ScreenUpdating = True
End Sub

Sub SearchContents(strRoot As String)
     
     'starts at path strRoot and looks at its subfolders and files
     'if there are files below it calls RunThrough, which opens them one by one
     'once its checked for files, it calls itself to check for subfolders.
     
If scrFso Is Nothing Then Set scrFso = CreateObject("scripting.filesystemobject")
        'start looking in the place we said to look
        Set oFolder = scrFso.GetFolder(strRoot)
        'tell it to be aware of sub folders
        Set oContentFolders = oFolder.subfolders
For Each oFolder In oContentFolders
        'tell is to be aware of any files in the sub folder
                Set oFiles = oFolder.Files
    'if the folder you are looking in contains folders, look in those folders themselves, but if you are not overwriting, check that it is a right folder
            If YNOverwrite = False Then
                If oFiles.Count > 0 And oFolder.Name = strMonth Then
                        RunThrough oFolder.Path
                Else
                        GoTo nextone
                End If
            Else
                        RunThrough oFolder.Path
            End If
nextone:
        'call ourselves in a moebus whatsit to see if there are subfolders below
        SearchContents oFolder.Path
Next
End Sub

Sub RunThrough(strPath As String)
    ' runs through a folder oPath, opening each file in that folder,
    ' calling a macro, and then closing each file in that folder
    'if we are repeating this it may already be set, otherwise, set it
    If scrFso Is Nothing Then Set scrFso = CreateObject("scripting.filesystemobject")
    'set up the subfolders to be searched
Set oFolder = scrFso.GetFolder(strPath)
    For Each oFile In oFolder.Files
            StrName = oFile.Name 'the name of this file
            Application.StatusBar = strPath & "\" & StrName 'the status bar is just to let us know where we are
            'open the file Name only if it is an Excel document
        If Right(StrName, 4) = ".xls" Or Right(StrName, 5) = ".xlsx" Then
            If YNOverwrite = True Then
                'If you only want to overwrite this year, then ensure the name is this year's
                If Left(StrName, 4) = strYear Then
                        'Make sure that the file is not readonly, and run overwrite
                        Set Wkbk = Workbooks.Open(Filename:=strPath & "\" & StrName, ReadOnly:=False)
                        Overwrite Wkbk
                Else
                        'nothing
                End If
            Else
                'If you are updating, check if the name of the file implies that it is a recent one
                If Left(StrName, 4) = strYear Then
                        Set Wkbk = Workbooks.Open(Filename:=strPath & "\" & StrName, ReadOnly:=False)
                        Update Wkbk
                Else
                        'nothing
                End If
            End If
        End If
    Next
NextoFile:
    'return control of status bar to Excel
    Application.StatusBar = False
End Sub

Sub Overwrite(Wkbk As Workbook)
'Only bother doing this if there actually is the standard summary sheet
If Sheets(1).Name = "Summary" Then
        'count one more than last time this was run so we keep moving down the target spreadsheet
        i = i + 1
        'go to the summary sheet and search for the totals row in column A
        Sheets("Summary").Activate
        Set rFound = Cells.Find("Totals", Cells(1, 1), xlValues, xlWhole, xlByRows, xlNext, False)
        'extend the range out to get all the data and copy it
        Range(rFound.Cells(1, 2), rFound.Cells(1, 49)).Copy
        'Go to the target workbook and the right place
        WbTarget.Activate
        WbTarget.Sheets("Data").Range("A2").Cells(i, 1).Activate
    'If the workbook from which we are getting data has a standard name, extract the date and the user
    If Left(Wkbk.Name, 2) = 20 Then
            ActiveCell.Value = Left(Wkbk.Name, 4) & "\" & Mid(Wkbk.Name, 6, 2)
            ActiveCell.Cells(1, 2).Value = Mid(Wkbk.Name, 9, 3)
    Else
    'otherwise, just put in the name as it appears
            ActiveCell.Value = Wkbk.Name
    End If
    'Paste the data
        ActiveCell.Cells(1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Else
'if the workbook does not contain the summary sheet, skip ahead to where we close it
GoTo end1
End If
end1:
'close without saving
Wkbk.Close (False)
End Sub

Sub Update(Wkbk As Workbook)
'Only bother doing this if there actually is the standard summary sheet
If Sheets(1).Name = "Summary" Then
        'go to the summary sheet and search for the totals row in column A
        Sheets("Summary").Activate
        Set rFound = Cells.Find("Totals", Cells(1, 1), xlValues, xlWhole, xlByRows, xlNext, False)
        'extend the range out to get all the data and copy it
        Range(rFound.Cells(1, 2), rFound.Cells(1, 49)).Copy
        'Go to the target workbook and the right place
        WbTarget.Activate
        WbTarget.Sheets("Data").Range("A65536").End(xlUp).Offset(1, 0).Activate
    'If the workbook from which we are getting data has a standard name, extract the date and the user
    If Left(Wkbk.Name, 2) = 20 Then
            ActiveCell.Value = Left(Wkbk.Name, 4) & "\" & Mid(Wkbk.Name, 6, 2)
            ActiveCell.Cells(1, 2).Value = Mid(Wkbk.Name, 9, 3)
    Else
    'otherwise, just put in the name as it appears
            ActiveCell.Value = Wkbk.Name
    End If
    'Paste the data
        ActiveCell.Cells(1, 3).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Else
'if the workbook does not contain the summary sheet, skip ahead to where we close it
GoTo end2
End If
end2:
'close without saving
Wkbk.Close (False)
End Sub
 



Data > Get External Data > From other sources > From Microsoft Query > Excel Files*

... and drill down to WHATEVER WORKBOOK as the query data source.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Ok, great - well there's the Query I've been searching for! I understand that i have to change my sheet into a table. If I just make the whole thing a table, fill it in white and lose the headers so it looks normal, does it change anything inherent about the sheet? Will it still function the same?

HighPlainsGrifter - I will start playing with yours when I have more time :) Looks fun, but for now, I'm trying to get something fast to work. Thanks all!
 
I understand that i have to change my sheet into a table.

A sheet with ROW 1, containing unique headings and data CONTIGUOUS with those headings, IS a valid table.

If I just make the whole thing a table, fill it in white and lose the headers so it looks normal, does it change anything inherent about the sheet?

A table must have headers in ROW 1, and I assume that "white" means empty rows/columns, which must be deleted to make the entire table contiuous.

Will it still function the same?

How is it functioning now? I would assume that the functionality of your sheet would improve in many ways, related to TABLE features.



Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
It isn't working. I have several charts and tables within each of these sheets. The sheets are budget analysis sheets with several different budget analysis tools on each one. Thank you though.
 

faq68-5184

Why not? I have very complex worksooks, with sometimes a dozen tables/sheets, usually from queries of external and internal data, and then several summary PivotTables, Charts, and Tables in a Summary Sheet.

There is no reason that you could not redesign your workbook, without compromising the purpose and summaries therein.

BTW, as you can see from my posted FAQ, these are NOT my personal views. These are recommendations from Excel HELP. Excel is so EASY to use, it becomes EASY to misuse and in effect, paint yourself into a corner with bad design.

So, as one surgeon said to the other, after having a friendly argument, "Suture self!"

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top