Help with loop VBA

MrMan32

New Member
Joined
Nov 1, 2018
Messages
12
Hello,

I'm new to the forum so thank you in advance for your help. I'm trying to use the loop function to extract and aggregate data across clients and can really use some help with my VBA code - I'm not sure where I am going wrong.

Here is what I have and am trying to do -
1) I have about 75 excel files in a folder called "2018 Clients"
2) The path to the folder is simply "Desktop\Client Folder\2018 Clients"
3) Each excel file has roughly 15 worksheets. The final worksheet is called "Summary"
4) I am trying to copy data (cells A1:E20) from every "Summary" worksheet in the folder to a single master worksheet to run data analysis.

Here is the code I'm using. I'm not getting any errors when I run the macro but the data is not populating. Any help is greatly appreciated!

Sub CombineWbks()


Dim Pth As String
Dim MstSht As Worksheet
Dim fname As String
Dim Rng As Range

Application.ScreenUpdating = False


Pth = "C:\Desktop\Client Folder\2018 Clients"
Set MstSht = ThisWorkbook.Sheets("Master Summary")
fname = Dir(Pth & "*xlsm*")
Do While Len(fname) > 0
Workbooks.Open (Pth & fname)
With Workbooks(fname)
.Sheets("Summary").Range("A1:E20").Copy MstSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
.Close , False
End With
fname = Dir
Loop


End Sub
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
What exactly do you mean by "opening the other workbooks" - how can I tell if it is doing this? Will they be physically open on my desktop?
 
Upvote 0
Remove this line
Code:
Application.ScreenUpdating = False
and step through the code, do you any workbooks open?
 
Upvote 0
This is working for me in testing. You'll need to tweak it for your own peculiarities, but you should be able to follow along. By nature I just automatically code in safeguards (been doing this too long). So you'll see some of that. It also uses a couple of "off-the-shelf" functions that I have in my function library modules which I've included here, so, viewed as a whole it may seem long and like a bit of overkill. But it gives you ample places to set watches and step code if something doesn't work as expected.

Code:
Sub CombineWbks()

    Const c_strAddrSource       As String = "A1:E20", _
          c_strSrceWksName      As String = "Summary", _
          c_strWildcardedName   As String = "señorhombre*.xl??"




    Dim booCloseWkbk    As Boolean, _
        rngSource       As Excel.Range, _
        rngTarget       As Excel.Range, _
        strDirArg       As String, _
        strFileName     As String, _
        strPath         As String, _
        wbkSource       As Excel.Workbook, _
        wksTarget       As Excel.Worksheet




    Application.ScreenUpdating = False


    '// change to whatever works for you
    Let strPath = fnAddPathSeparator(ThisWorkbook.Path)
    
    Set wksTarget = ThisWorkbook.Sheets("Master Summary")
    Let strDirArg = strPath & c_strWildcardedName
    Let strFileName = Dir(strDirArg)
    
    Do While Len(strFileName) > 0
        If fnWorkbookOpen(strFileName) Then
            Set wbkSource = Workbooks(fnJustFileName(strFileName))
            Let booCloseWkbk = False
        Else
            Set wbkSource = Workbooks.Open(strFileName)
            Let booCloseWkbk = True
        End If
        
        Set rngSource = wbkSource.Worksheets(c_strSrceWksName).Range(c_strAddrSource)
        Set rngTarget = wksTarget.Range("A" & Rows.Count).End(xlUp).Offset(1)
        
        rngSource.Copy rngTarget
        
        If booCloseWkbk Then wbkSource.Close False


        Let strFileName = Dir
    Loop


End Sub




' _____________________________________________________________________________
' fn ADD PATH SEPARATOR                                                     |ü|
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' Descrip:  Usually a PATH will not have the ending "\" and I need it to
'           to have one. However I don't want to just blindly concatenate a
'           path separator just in case, for whatever reason, the path does
'           already end in a separator.  I weary of coding this check before
'           concatenating every time, hence this function.
'
' Args:     strPath · · · · the inbound path name
'
' Returns:  string· · · · · the outbound path ending in a path separator
'
' Date          Developer   Comments
' ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
' 14 Oct 2009   G. Truby    • this version, I probably wrote the initial version
'                             of this function in the late nineties.
' _____________________________________________________________________________
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  Function fnAddPathSeparator(ByVal strPath As String) As String
' _____________________________________________________________________________


    If Right(strPath, 1) <> Application.PathSeparator Then
        Let strPath = strPath & Application.PathSeparator
    End If
    
    Let fnAddPathSeparator = strPath


End Function


' _____________________________________________________________________________
' fn WORKBOOK OPEN
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' Descrip:  Tests whether a workbook with a given name is already open.
'
' Args:     strWBName· · · · the name of the workbook sought
'
' Returns:  Boolean· · · · · TRUE if the workbook is open
'
' Date          Developer   Comments
' ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
' 12 Oct 2009   G. Truby    • there are countless versions of this function
'                             floating around the internet. I just happened to
'                             wrote this one from scratch for this library on
'                             this date.
' _____________________________________________________________________________
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Function fnWorkbookOpen(ByVal strWBName As String) As Boolean
' _____________________________________________________________________________


    Dim wb1 As Excel.Workbook
    
    Let strWBName = fnJustFileName(strWBName)
    
    On Error Resume Next
    Set wb1 = Application.Workbooks(strWBName)
    
    Let fnWorkbookOpen = (Err.Number = 0)
    
    Set wb1 = Nothing


    End Function


' _____________________________________________________________________________
' fn JUST FILE NAME                                                         |ü|
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' Descrip:  Strip the path off of a full file name. Or fetch wb name from
'           an external reference.
'
' Args:     strFile · · · · the name or name & path of to be stripped
'
' Returns:  string· · · · · just the filename without any path
'
' Date          Developer   Comments
' ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
' 08 Oct 2009   G. Truby    • initial version
' 03 May 2015   G. Truby    • adding the ability to return the workbook name
'                             from an external reference.
' _____________________________________________________________________________
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  Function fnJustFileName(ByVal strFullFileName As String) As String
' _____________________________________________________________________________


    Dim p%, jfn$
    
    
    If Left$(strFullFileName, 1) <> "=" Then
        Let p = InStrRev(strFullFileName, Application.PathSeparator)
        Let jfn = Right$(strFullFileName, Len(strFullFileName) - p)
    Else
        Let p = InStr(strFullFileName, "[")
        Let jfn = Right$(strFullFileName, Len(strFullFileName) - p)
        Let p = InStr(jfn, "]")
        Let jfn = Left$(jfn, p - 1)
    End If
    
    Let fnJustFileName = jfn
    
    End Function

@ Jon - I thought you were over tossing back a few with Ken in Bulgaria or something. Surprised to see you here.
 
Upvote 0

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top