Copy Entire column into an array in excel vba

Question

I am trying to develop a macro which will open excel files specified by user-prompted location, find a specific column and paste the entire column in the active workbook. So far I have written the code which can loop through the files in the directory, opens the file, search for the column and store the entire column in an array. Now whenever I am trying a Run Time Error saying "Overflow"! Can anyone help me to fix this issue? Also, I want to integrate below item in the macro: 1. Find multiple columns from each file and paste those columns in a sheet. So for multiple files, I should paste the columns in individual worksheet dynamically. How can I do that? Any help is appreciated. Thanks. Below is my code I have written so far:

Sub Test_Template()

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

Dim wb As Workbook
Dim myPath As String, myFile As String
Dim myExtension As String
Dim t As Range, rng As Range, rng2 As Range
Dim dblAvg As Single, eng_spd As Single, i As Integer
Dim FldrPicker As FileDialog
Dim rowCtr As Integer
Dim myarray1 As Variant
rowCtr = 2


'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With


'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
Execute:
Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Ensure Workbook has opened before moving on to next line of code
      DoEvents

 'Find "Time" in Row 1
  With wb.Worksheets(1).Rows(9)
   Set t = .Find("Time", lookat:=xlPart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
     If Not t Is Nothing Then
        'Columns(t.Column).EntireColumn.Copy _
         ' Destination:=Sheets(3).Range("A1")
    Set rng2 = Columns(t.Column)
    myarray1 = rng2
       Else: MsgBox "Time Not Found"
     End If
  End With

 'Save and Close Workbook
      wb.Close 'SaveChanges:=True

    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

With ActiveSheet
For i = LBound(myarray1) To UBound(myarray1)
    Debug.Print myarray1(i, 1)
Next
End With
    'Get next file name
      myFile = Dir
Loop

'Message Box when tasks are completed
  'MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True


End Sub

Answer 1

here is your code with clutter, like goto commands, and unused With commands removed

Sub Test_Template()

    'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them

    Dim wb As Workbook
    Dim myPath As String, myFile As String
    Dim myExtension As String
    Dim t As Range, rng As Range, rng2 As Range
    Dim dblAvg As Single, eng_spd As Single, i As Long
    Dim FldrPicker As FileDialog
    Dim rowCtr As Long
    Dim myarray1 As Variant
    rowCtr = 2


    ' Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    ' Retrieve Target Folder Path From User
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show = True Then
            myPath = .SelectedItems(1) & "\"
        End If
    End With


    myPath = myPath                                               ' In Case of Cancel
    If myPath <> "" Then

        myExtension = "*.xls*"                                    ' Target File Extension (must include wildcard "*")

        myFile = Dir(myPath & myExtension)                        ' Target Path with Ending Extention

        Do While myFile <> ""                                     ' Loop through each Excel file in folder

            Set wb = Workbooks.Open(Filename:=myPath & myFile)    ' Set variable equal to opened workbook

            DoEvents                                              ' yield processing time to other events

            Set t = wb.Worksheets(1).Rows(9).Find("Time", lookat:=xlPart)  ' Find "Time" in Row 1  ????

            If Not t Is Nothing Then

'               Columns(t.Column).EntireColumn.Copy _
                Destination:=Sheets(3).Range("A1")

                myarray1 = Columns(t.Column)                      ' found: copy the column to Sheet 2, Column A

            Else
                MsgBox "Time Not Found"
            End If

            wb.Close ' SaveChanges:=True                          ' Save and Close Workbook

            DoEvents                                              ' yield processing time to other events

            For i = LBound(myarray1) To UBound(myarray1)
                Debug.Print myarray1(i, 1)
            Next

            myFile = Dir                                          ' Get next file name
        Loop

'       MsgBox "Task Complete!"

    End If

    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub