Excel VBA How to open more workbook using array?

Question

i have a job which i need to merge 4 files together. May i know what if i have more files in coming future to merge, instead keying the "open workbook"code. What kind of method should i use? and yet meet the lowest line merge criteria as well. Below is the code i have attempt so far

Sub GetFile()
Dim Book1Path As Variant, Book2Path As Variant, Book3Path As Variant, Book4Path As Variant
Dim SourceWB As Workbook, DestWB As Workbook
Dim lRow As Long

Dim ws1, ws2, ws3, ws4 As Worksheet
Dim c3ll1, c3ll2, c3113, c3114, range1, range2, range3, range4 As Range

'## Open both workbook first:

Book1Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 1")
If Book1Path = False Then Exit Sub
Set SourceWB = Workbooks.Open(Book1Path)

Book2Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 2")
If Book2Path = False Then Exit Sub
Set DestWB = Workbooks.Open(Book2Path)

Book3Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 3")
If Book3Path = False Then Exit Sub
Set DestWB = Workbooks.Open(Book3Path)

Book4Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 4")
If Book4Path = False Then Exit Sub
Set DestWB = Workbooks.Open(Book4Path)

'Copy.
With SourceWB.Sheets("Report")
   lRow = .Cells(Rows.Count, 1).End(xlUp).Row
   .Range("A2:F" & lRow).Copy
End With

'Active Merge Workbook
ThisWorkbook.Activate

'Paste.
Columns("A").Find("", Cells(Rows.Count, "A")).Select
Selection.PasteSpecial

'Active CWPI Topic 1 Assessment Workbook
SourceWB.Activate

'Copy.
With SourceWB.Sheets("Report")
lRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("G2:G" & lRow).Copy
End With

'Active Merge Workbook
ThisWorkbook.Activate

'Paste.
Columns("G").Find("", Cells(Rows.Count, "G")).Select
Selection.PasteSpecial

Set ws1 = SourceWB.Sheets("Report")
Set ws2 = DestWB.Sheets("Report")
Set ws3 = DestWB.Sheets("Report")
Set ws4 = DestWB.Sheets("Report")

lastrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set range2 = ws2.Range("A2:A" & lastrow2)
lastrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set range1 = ws1.Range("A2:A" & lastrow1)
For Each c3ll2 In range2

a = 0
activerow2 = c3ll2.Row
For Each c3ll1 In range1
    If c3ll1.Value = c3ll2.Value Then
        activerow1 = c3ll1.Row
        Cells(activerow1, "H") = ws2.Cells(activerow2, 3)
        Cells(activerow1, "I") = ws2.Cells(activerow2, 4)
        Cells(activerow1, "J") = ws2.Cells(activerow2, 5)
        Cells(activerow1, "K") = ws2.Cells(activerow2, 6)
        Cells(activerow1, "L") = ws2.Cells(activerow2, 7)
        a = 1                                                   'Username is found
        Exit For
        End If
Next c3ll1
If a = 0 Then                       'If Username is not found print at end
    lastrow1 = lastrow1 + 1
    Cells(lastrow1, "A") = ws2.Cells(activerow2, 1)
    Cells(lastrow1, "B") = ws2.Cells(activerow2, 2)
    Cells(lastrow1, "H") = ws2.Cells(activerow2, 3)
    Cells(lastrow1, "I") = ws2.Cells(activerow2, 4)
    Cells(lastrow1, "J") = ws2.Cells(activerow2, 5)
    Cells(lastrow1, "K") = ws2.Cells(activerow2, 6)
    Cells(lastrow1, "L") = ws2.Cells(activerow2, 7)
End If
Next c3ll2

'Columns Width Autofit
ActiveSheet.Columns.AutoFit

With Application
      Cells(.CountA(Columns("A:A")) + 1, 1).Select
      .ScreenUpdating = True
      .DisplayAlerts = False
      SourceWB.Close
      DestWB.Close
End With

End Sub

Answer 1

So...you're looking for a loop to open up more workbooks in an easy way? Right now, you are not opening 3 versions of DestWB like you think you are. You are instead overwriting DestWB each time you call...

Set DestWB = Workbooks.Open(BookXPath)

I would replace your three blocks that open the path, check the path, and then open the path to the workbook DestWB with the following:

'Create an array of paths, and a corresponding array of workbooks
Dim paths() As String, wbs() as Workbook
ReDim paths(3)
'ReDim wbs to the same as path so its easier to adjust in the future
ReDim wbs(UBound(paths))
'Set your paths, then loop through them to assign your workbooks
Dim x as Integer
For x = 1 To UBound(paths)
     paths(x) = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter " + CStr(x))
     If paths(x) = "False" Then
          Exit Sub
     End If
     Set wbs(x) = Workbooks.Open(paths(x))
Next x

You can use the same loop methodology to do the other tasks in this macro. You can also eliminate all your activating of the ThisWorkbook by setting it as a variable.

Dim thisWB as Workbook
Set thisWB = ThisWorkbook

This will in turn let you clean up this code...

Columns("A").Find("", Cells(Rows.Count, "A")).Select
Selection.PasteSpecial

Into this code...

thisWB.Sheets("SOMESHEET").Columns("A").Find("", Cells(Rows.Count, "A")).PasteSpecial

In general .Select and Selection should be avoided. Search around stackoverflow and Google, there are plenty of examples for both loops and eliminating .Select and Selection.