Search code examples
excelvba

Loop Excel code that works on one file through multiple files in a folder


I have a working Excel macro (Macro 1) that deletes columns/rows, moves columns/rows, calculates new columns, etc.).

I have a different macro (Macro 2) that loops through a folder (selected via dialog box) and performs all of the functions of Macro 1 (I was given this code. I believe it is VBA).
It doesn't reference Macro 1 because that's in a different Excel file, but Macro 1 is copied into Macro 2. I have used this method for numerous other data sets in the past couple of years. (I'm open to changing this, if it's easier/faster/may solve my problem.)

When I use Macro 2 to loop through files in a folder and make changes, on any number of files, it messes up in the same way.

Sub LoopThroughFolder_Exp1a()
Dim MyFolder As String 'Path collected from the folder picker dialog
Dim MyFile As String 'Filename obtained by DIR function
Dim wbk As Workbook 'Used to loop through each workbook

On Error Resume Next
Application.ScreenUpdating = False
'Opens the folder picker dialog to allow user selection
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
        MsgBox "You did not select a folder"
        Exit Sub
    End If
    MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
End With
MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
'Loop through all files in a folder until DIR cannot find anymore
Do While MyFile <> ""
    'Opens the file and assigns to the wbk variable for future use
    Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
    'This is Macro 1 below
    Columns("K:R").Select
    Selection.Delete Shift:=xlToLeft
    Columns("L:L").Select
    Selection.Delete Shift:=xlToLeft
    Columns("M:AV").Select
    Selection.Delete Shift:=xlToLeft
    Columns("Z:AC").Select
    Selection.Delete Shift:=xlToLeft
    Columns("Y:Y").Select
    Selection.Cut
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Rows("2:27").Select
    Selection.Delete Shift:=xlUp
    Range("B:D,E:E,G:G").Select
    Range("G1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("I:I").Select
    Selection.Cut
    Range("U1").Select
    ActiveSheet.Paste
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("K2:S2").Select
    Selection.Delete Shift:=xlUp
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "ParticipantOrder"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("D2:D157").Select
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Stop:=156, Trend:=False
    Range("E1").Select
        ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("E1:E157" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:U157")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A122:D157").Select
    Selection.Delete Shift:=xlToLeft
    Range("D1").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("D1:D121" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:U121")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D121"), Type:=xlFillSeries
    Range("D2:D121").Select
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "ExcludeParticipant"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(AVERAGE(R2C[-1]:R121C[-1])<0.85,1,0)"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C121")
    Range("C2:C121").Select
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "PopupCorrect"
    Range("W2").Select
    ActiveCell.FormulaR1C1 = _
       "=IF(AND(RC[-3]>0,RC[-3]=RC[-1]),1,IF(OR(RC[-3]=""None"",RC[-3]=""""),"""",0))"
    Range("W2").Select
    Selection.AutoFill Destination:=Range("W2:W121")
    Range("W2:W121").Select
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "PopupAccuracy"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=AVERAGE(R2C[20]:R127C[20])"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D121")
    Range("D2:D121").Select
    Range("I1").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("I1:I121" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A2:X121")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("U:U").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("U:U").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("U:V").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[-6],CHAR(10),"""")"
    Range("U2").Select
    Selection.AutoFill Destination:=Range("U2:Z2"), Type:=xlFillDefault
    Range("U2:Z2").Select
    Selection.AutoFill Destination:=Range("U2:Z121")
    Range("U2:Z121").Select
    Range("O1:T1").Select
    Selection.Copy
    Range("U1").Select
    ActiveSheet.Paste
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("O:T").Select
    Range("T1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("2:3").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("E:E").Select
    Selection.Cut
    Columns("M:M").Select
    Selection.Insert Shift:=xlToRight
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "na"
    Selection.AutoFill Destination:=Range("L2:L5"), Type:=xlFillDefault
    Range("L2:L5").Select
    Columns("U:U").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("U:V").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "Recall1_Correct"
    Selection.AutoFill Destination:=Range("U1:Z1"), Type:=xlFillDefault
    Range("U1:Z1").Select
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "Recall2_Correct"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "Recall3_Correct"
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "Recall4_Correct"
    Range("Y1").Select
    ActiveCell.FormulaR1C1 = "Recall5_Correct"
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "Recall6_Correct"
    Range("U2").Select
    ActiveCell.FormulaR1C1 = ""
    Range("U6").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC8=2,OR(RC[-6]=R[-1]C12,RC[-6]=RC12)),1,IF(AND(RC8=3,OR(RC[-6]=R[-2]C12,RC[-6]=R[-1]C12,RC[-6]=RC12)),1,IF(AND(RC8=4,OR(RC[-6]=R[-3]C12,RC[-6]=R[-2]C12,RC[-6]=R[-1]C12,RC[-6]=RC12)),1,IF(AND(RC8=5,OR(RC[-6]=R[-4]C12,RC[-6]=R[-3]C12,RC[-6]=R[-2]C12,RC[-6]=R[-1]C12,RC[-6]=RC12)),1,IF(AND(RC8=6,OR(RC[-6]=R[-5]C12,RC[-6]=R[-4]C12,RC[-6]=R[-3]C12,RC[-6]=R[-2]C12" & _
        ",RC[-6]=R[-1]C12,RC[-6]=RC12)),1,IF(RC[-6]="""","""",0))))))" & _
        ""
    Range("U6").Select
    Selection.AutoFill Destination:=Range("U6:Z6"), Type:=xlFillDefault
    Range("U6:Z6").Select
    Selection.AutoFill Destination:=Range("U6:Z125"), Type:=xlFillDefault
    Range("U6:Z125").Select
    Columns("AA:AA").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AA1").Select
    ActiveCell.FormulaR1C1 = "RecallCorrect"
    Range("AA2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-6]<>"""",SUM(RC[-6]:RC[-1]),"""")"
    Range("AA2").Select
    Selection.AutoFill Destination:=Range("AA2:AA125")
    Range("AA2:AA125").Select
    Columns("O:T").Select
    Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False, _
        FormulaVersion:=xlReplaceFormula2
    Range("A1:AE125").Select
    Range("P9").Activate
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("2:5").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("F1").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range("F1:F121" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A2:AE121")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("AB:AB").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("AB:AC").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AB1").Select
    ActiveCell.FormulaR1C1 = "ReadingSpanBlock1"
    Selection.AutoFill Destination:=Range("AB1:AG1"), Type:=xlFillDefault
    Range("AB1:AG1").Select
    Range("AB2").Select
    ActiveCell.FormulaR1C1 = "=SUM(R2C27:R21C27)"
    Range("AB2").Select
    Selection.AutoFill Destination:=Range("AB2:AB121")
    Range("AB2:AB121").Select
    Range("AC2").Select
    ActiveCell.FormulaR1C1 = "=SUM(R22C27:R41C27)"
    Range("AC2").Select
    Selection.AutoFill Destination:=Range("AC2:AC121")
    Range("AC2:AC121").Select
    Range("AD2").Select
    ActiveCell.FormulaR1C1 = "=SUM(R42C27:R61C27)"
    Range("AD2").Select
    Selection.AutoFill Destination:=Range("AD2:AD121")
    Range("AD2:AD121").Select
    Range("AE2").Select
    ActiveCell.FormulaR1C1 = "=SUM(R62C27:R81C27)"
    Range("AE2").Select
    Selection.AutoFill Destination:=Range("AE2:AE121")
    Range("AE2:AE121").Select
    Range("AF2").Select
    ActiveCell.FormulaR1C1 = "=SUM(R82C27:R101C27)"
    Range("AF2").Select
    Selection.AutoFill Destination:=Range("AF2:AF121")
    Range("AF2:AF121").Select
    Range("AG2").Select
    ActiveCell.FormulaR1C1 = "=SUM(R102C27:R121C27)"
    Range("AG2").Select
    Selection.AutoFill Destination:=Range("AG2:AG121")
    Range("AG2:AG121").Select
    Range("A1:AK121").Select
    Range("AA12").Activate
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Participant"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "SentenceCorrect"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "SentenceResponse"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "SentenceRT"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Recall_1"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "Recall_2"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Recall_3"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Recall_4"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "Recall_5"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "Recall_6"
    Range("AI1").Select
    ActiveCell.FormulaR1C1 = "PopupRT"
    Range("AH1").Select
    ActiveCell.FormulaR1C1 = "PopupAnswer"
    Range("A1").Select
    wbk.Close savechanges:=True
    MyFile = Dir 'DIR gets the next file in the folder
Loop
Application.ScreenUpdating = True
End Sub

Solution

  • Always a good idea to use an explicit worksheet reference:

    Dim ws As Worksheet
    '...
    '...
    MyFile = Dir(MyFolder) 'DIR gets the first file of the folder
    'Loop through all files in a folder until DIR cannot find anymore
    Do While MyFile <> ""
       'Opens the file and assigns to the wbk variable for future use
       Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
    
       Set ws = wbk.Worksheets(1) '<<< assuming only one sheet in each file
    
       'This is Macro 1 below
        ws.Columns("K:R").Delete Shift:=xlToLeft
        ws.Columns("L:L").Delete Shift:=xlToLeft
        ws.Columns("M:AV").Delete Shift:=xlToLeft
        ws.Columns("Z:AC").Delete Shift:=xlToLeft
    
        'etc etc
    

    Your sheet-processing code needs a lot of fixes though: review the link BigBen posted as a starting point.

    For example ActiveWorkbook.Worksheets("Sheet1") will error out if "the sheet name is based on the file name, so it's different for every file"