Excel VBA How to open more workbook using array? - arrays

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.