Solved

Extract data from multiple worksheets in a workbook?

Posted on 2013-05-23
2
188 Views
Last Modified: 2013-05-28
Good morning,

I want to add data from another sheet to this summary macro.
Right now, it only looks at Worksheet "Finance" but I want to add 2 new Worksheets, "Company" and "Buyer" to the Summary too.

I want the macro to add "Company" worksheet Cell "A2" and "G2" and "Buyer" worksheet Cell "B2" and "F2".

Thank you!!



Option Explicit

Sub Master()
    
    Dim StartPath As String
    Dim Results() As Variant
    
    StartPath = GetDirectory2
    
    If StartPath <> "" Then
        Application.ScreenUpdating = False
        ReDim Results(0) As Variant
        DoTheWork Results, StartPath
        Workbooks.Add
        Range("a1:b" & UBound(Results, 2)).Value = Application.Transpose(Results)
        Columns.AutoFit
        Application.ScreenUpdating = True
        MsgBox "Done"
    End If
    
End Sub

Private Sub DoTheWork(ByRef Results As Variant, FldPath As String)
    
    Dim fso As Object, fld As Object, fil As Object, sf As Object
    Dim WbWasOpen As Boolean
    Dim wb As Workbook, ws As Worksheet
    Dim GetValue As Variant
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(FldPath)
    
    On Error Resume Next

    For Each fil In fld.Files
        If LCase(fil.Name) Like "*verification*.xls*" Then
            Set wb = Workbooks(fil.Name)
            If Err <> 0 Then
                WbWasOpen = False
                Set wb = Workbooks.Open(fil.Path)
                Err.Clear
            Else
                WbWasOpen = True
            End If
            Set ws = wb.Worksheets("Finances")
            If Err = 0 Then
                GetValue = ws.Range("f12").Value
                If Not WbWasOpen Then wb.Close False
                If LBound(Results, 1) > 0 Then
                    ReDim Preserve Results(1 To 2, 1 To UBound(Results, 2) + 1) As Variant
                Else
                    ReDim Results(1 To 2, 1 To 2) As Variant
                    Results(1, 1) = "File"
                    Results(2, 1) = "Value"
                End If
                Results(1, UBound(Results, 2)) = fil.Path
                Results(2, UBound(Results, 2)) = GetValue
            Else
                Err.Clear
            End If
        End If
    Next
    
    On Error GoTo 0

    For Each sf In fld.SubFolders
        DoTheWork Results, sf.Path
    Next
    
End Sub

Private Function GetDirectory2(Optional Msg As String = "Select Folder:") As String
    
    ' Use this version when you want to be able to create a new directory and
    ' have the function return that path
    
    Dim objShell As Object 'Shell32.Shell
    Dim objFolder As Object 'Shell32.Folder
    Dim objFolderItem As Object 'Shell32.FolderItem
    
    GetDirectory2 = ""
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, Msg, 0, 0)
    
    If (Not objFolder Is Nothing) Then
        Set objFolderItem = objFolder.Self
        If (Not objFolderItem Is Nothing) Then
            GetDirectory2 = objFolderItem.Path
        End If
    End If
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
    
End Function

Open in new window

0
Comment
Question by:crepe
2 Comments
 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 500 total points
Comment Utility
can you post a sampleworkbook as that is different to what the current macro does.

do you want just the 2 values from the workkbook ?
you could try using the macro recorder while copying data manually and post the results of that for us to review.  its a very good starting point.
0
 

Author Closing Comment

by:crepe
Comment Utility
I figured it out on my own. Thank you!
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now