Solved

Extract data from multiple worksheets in a workbook?

Posted on 2013-05-23
2
199 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
ID: 39196054
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
ID: 39203267
I figured it out on my own. Thank you!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
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 …
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

863 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

18 Experts available now in Live!

Get 1:1 Help Now