Loop through VBA collection

Rymare

New Member
Joined
Apr 20, 2018
Messages
37
I have an excel with a list of paths:

ghgh.png


This list can change length--sometimes there are 100 .xlsx files, sometimes 4, etc. But always xlsx and always in the same sheet in my workbook (Project Specialist Compile, sheet ghgh). The paths are not fixed, they constantly change so though the list appears to share certain patterns, that will not always be the case.

I want to be able to open these excels, take the data from the first sheet in each excel, and merge it into one sheet in my Project Specialist Compile workbook (sheet is called Addresses). Then have the code move to the next path in the collection open that one, copy paste, etc. The excels do not have a fixed range to paste. They all have a header, but can have 1 row with data or 500 rows with data, so I can't set a fixed range to copy there either. They look like this:

EXCELS.png


I need the code to count what cells have data (paths), put them into the collection, and then loop them ('for each path in collection' syntax). I want to end up with this:

WHATIWABNT.png



I would like to NOT have each excel pop up, open, copy, paste then close because that could take forever if there's a long list of paths.

The code below always stops at

Code:
Set dirObj = mergeObj.GetFolder("vElement.Value")

and shows:

pathnotfouind.png



Code:
Option ExplicitSub openingandcopying()


Dim bookList As Workbook
Dim wsp As Worksheet: Set wsp = Sheets("ghgh")
Dim mergeObj As Object
Dim dirObj As Object
Dim filesObj As Object
Dim everyObj As Object
Dim colMyCol As New Collection
Dim vElement As Variant
Dim rRange As Range
Dim rCell As Range
Dim lCount As Long




Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
Set rRange = wsp.Range("A1")
Set rRange = Range(rRange, rRange.End(xlDown))


For Each rCell In rRange
   colMyCol.Add rCell.Value
Next


For Each vElement In colMyCol
    Set dirObj = mergeObj.GetFolder("vElement.Value")
    Set filesObj = dirObj.Files
        For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
 
        Range("A2:X" & Range("A65536").End(xlUp).Row).copy
        ThisWorkbook.Sheets("Addresses").Activate


        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        bookList.Close
        Next everyObj
Next vElement


End Sub
 
Code:
Sub Rymare()
  Dim cell As Range

  With Worksheets("ghgh")
    For Each cell In .Range("A1", Cells(Rows.Count, "A").End(xlUp)).Cells
      If Len(Dir(cell.Value)) Then
        With Workbooks.Open(cell.Value)
          Range("A2:X" & Cells(Rows.Count, "A").End(xlUp).Row).Copy _
              ThisWorkbook.Worksheets("Addresses").Cells(Rows.Count, "A").End(xlUp)(2)
          .Close SaveChanges:=False
        End With
      Else
        MsgBox "File not found: " & cell.Value
      End If
    Next cell
  End With
End Sub
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Ok....but it still caused excel to crash? Is there a fix or a way to move more smoothly? So it doesn't crash?
 
Upvote 0
I have no way of know why Excel is crashing. What happens when you step through the code, where does it fall over?
 
Upvote 0
This

Code:
For Each cell In .Range("A1", Cells(Rows.Count, "A").End(xlUp)).Cells

should be

Code:
For Each cell In .Range("A1", [SIZE=6][COLOR="#FF0000"].[/COLOR][/SIZE]Cells([SIZE=6][COLOR="#FF0000"].[/COLOR][/SIZE]Rows.Count, "A").End(xlUp)).Cells
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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