Do While Loop Not Looping through Folder

Question

I have around a 1000 files in a folder that I want to loop through individually, process the data, then copy/paste in a separate *.xlsx workbook. There seems to be an issue with the code that is "processing" the data because when I try to come back to the Do-While-Loop it doesn't open the next file. If I don't run the additional code it will loop through all of the files

Sub LoopThroughSingle_TXT_Files()
    Dim currentPath As String
    Dim currentFile As String

    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="D:\Folder2\cd1.xlsx"
    Dim cd1 As Workbook
    Set cd1 = Workbooks("cd1")

    currentPath = "D:\Folder1\Data\"
    currentFile = Dir(currentPath & "*.txt")
    Do While currentFile <> ""
        Workbooks.Add
        ActiveWorkbook.SaveAs Filename:="D:\Folder1\Data\wb1.xlsx"

        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & currentPath & currentFile, Destination:=Range("$A$1"))
            .NAME = "Data"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        Module3.z_CleanData
        Module3.zz_paste_in_combined()

        currentFile = Dir

    Loop
    Application.ScreenUpdating = True

End Sub

Sub z_Clean_Data()

    Range("M2").Activate:     ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
    Range("N2").Activate:     ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
    Range("O2").Activate:     ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
    Range("P2").Activate:     ActiveCell.FormulaR1C1 = "=IFS(AND(RC1="""",RC[-11]=""""),R[-1]C[-11],AND(RC1=1,RC[-11]=""""),R[1]C[-11],RC[-11]<>"""",RC[-11])"
    Range("Q2").Activate:    ActiveCell.FormulaR1C1 = "=IF(RC[-11]="""",R[-1]C[-11],RC[-11])"
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    Range("M2:Q" & lastRow).Activate:   Selection.FillDown:     Selection.Copy
    Range("B2").Activate:   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False:    Application.CutCopyMode = False
    Range("M:Q").Delete

    Application.Goto Reference:="R1C1:R500C6":      Selection.Copy

End Sub

Sub zz_paste_in_combined()

    Dim wb1 As Window
    For Each wb1 In Application.Windows
        If wb1.Caption Like "wb1*.xlsx" Then
            wb1.Activate
            Exit For
        End If
    Next

    Dim cd1 As Window
    For Each cd1 In Application.Windows
        If cd1.Caption Like "cd1*.xlsx" Then
            cd1.Activate
            Exit For
        End If
    Next

    cd1.Activate
    Range("A1").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False:
    Application.CutCopyMode = False

    wb1.Activate
    ActiveWorkbook.Close SaveChanges:=False

    '###Clear files from combined_data if it exists
    Dim myFilePath2Delete As String:    myFilePath2Delete = "D:\Kibot\Data\!Daily Data (saved as EOD)\Volume-Price Screen\zNuLong_Analysis_Individual\.xlsx"
    If Dir(myFilePath2Delete) <> "" Then
        Kill myFilePath2Delete
    End If

End Sub

I've tried so many different ways to figure out a solution but have been unable to get it to work the way I want. I am really not sure about how to process the data, paste it into a different workbook and then proceed through the Do-While-Loop without having it end unexpectedly.

Thank you in advance for any input.

Steven

I would guess, that your implicit use of ActiveSheet/ActiveWorkbook and `Select`, causes trouble.See https://stackoverflow.com/questions/30387819/setting-a-range-on-a-different-sheet-without-having-to-select-that-sheet and https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — ComputerVersteher, Sep 30 '18 at 21:48
If you are calling `dir` with arguments in the additional code, using`dir()` with out arguments when you return to your 1000-file loop will now be using the arguments you last passed it in the additional code. If this is the problem, you could create a string array and assign all 1000 files to the array in advance. Then loop through the array, which leaves you free to use `dir` again in the additional code. Hope that makes sense. — chillin, Oct 01 '18 at 07:05

score 0 · Accepted Answer · answered Sep 30 '18 at 22:09

I’ll work from something like this:

Sub mymacro()

Dim objFile As Scripting.File
Dim objFolder As Scripting.Folder
Dim mywb as string

Set objFolder = CreateObject("Shell.Application").Namespace(objFolder.Path)

    'Loop through each file in the folder
    For Each objFile In objFolder.Files

     objFile.Open (objFile.Path)

     mywb = objFile.Name

     Workbooks.Add
     ‘Your code here

    Next objFile

End sub

hope this helps!!

Do While Loop Not Looping through Folder

1 Answers1