Need help with do while loop

peBowl

New Member
Joined
Jul 20, 2021
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
  2. MacOS
Hi everyone,

I am new to vba programming and I edited a code to extract several txt-Files from a folder to a new workbook, thereby, each txt file is copied to a separate worksheet. Since I have about 50 folders I wrote a loop to extract the data from the txt files.
The for loop works fine so far, but I always get the same error so I hope you can help me to fix the problem: for the first folder the script is working properly, but not for the next step because the loop goes on (J=2) but the script is searching for files located in the previous folder (J=1); that's why I assume that my mistake is in the Do While xFile <> "" Loop but I have no idea how to fix it. Can anyone of you guys help me out? I would really appreciate that. I searched for days on google as well as in forums but I wasn't able to find a solution.

Here is my code:

VBA Code:
Sub Test()

    Dim wb1 As Workbook
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
   
    Application.DisplayAlerts = False

    For J = 1 To 27 Step 1
        If J < 10 Then a = "0"
        If J = 10 Then a = ""
        If J > 10 Then a = ""
       
       
        Set wb1 = Workbooks.Add
        Set wb1 = Application.ActiveWorkbook

       
        xStrPath = "G:\Reko\scans\scan" & a & J & "\DIFF_DATA_UNBINNED\"
       
        'If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
        xFile = Dir(xStrPath & "*.txt")

            Do While xFile <> ""
                xFiles.Add xFile, xFile
                xFile = Dir()
            Loop
       
        Set xToBook = ActiveWorkbook
        If xFiles.Count > 0 Then
            For I = 1 To xFiles.Count
                Set wb1 = Workbooks.Open(xStrPath & xFiles.Item(I))
                wb1.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
                On Error Resume Next
                ActiveSheet.Name = xFiles(I)
                On Error GoTo 0
                wb1.Close False
            Next
            Sheets("Tabelle1").Delete
        End If
       
        'specify safe directory & name
        ActiveWorkbook.SaveAs Filename:="G:\Reko\scans\scan" & a & J & "\DIFF_DATA_UNBINNED\scan" & a & J & "_DIFF_DATA.xlsx"
        ActiveWorkbook.Close SaveChanges:=False
   
    Next J
   
    Application.DisplayAlerts = True
End Sub

Many thanks in advance and best regards,
peBowl
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,618
Office Version
  1. 2007
Platform
  1. Windows
Hi and welcome to MrExcel

You must clear the variable collection xFiles.

After this line
VBA Code:
xStrPath = "G:\Reko\scans\scan" & a & j & "\DIFF_DATA_UNBINNED\"

Add this line:
VBA Code:
        'clean xFiles
        Set xFiles = Nothing
 
Solution

peBowl

New Member
Joined
Jul 20, 2021
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
  2. MacOS
Hi and welcome to MrExcel

You must clear the variable collection xFiles.

After this line
VBA Code:
xStrPath = "G:\Reko\scans\scan" & a & j & "\DIFF_DATA_UNBINNED\"

Add this line:
VBA Code:
        'clean xFiles
        Set xFiles = Nothing
Many, many thanks @DanteAmor, I really appreciate that! I just implemented it and it works fine!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,618
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Forum statistics

Threads
1,141,616
Messages
5,707,419
Members
421,509
Latest member
someinternetuser

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top