For Each Loop Structure/Exiting Early

[MAM8433]

I need help with my for-each loop VBA logic.

I have been tasked with modifying my VBA code to find files with specific date stamps. Until I get access to the MonthView control, I have added msgboxes to prompt for a start date and end date. For each file in my collection, I plan to test the fileÂ’s DateLastModified and if itÂ’s not within the start and end dates, move on to the next file in the collection. Otherwise, the file is processed.

I wrote if-then code that would exit the for-each loop if the date stamp is not between start and end dates. Now, when I compile the code, I get the error message that the Next statement at the bottom of my loop is missing the For statement. Would you please explain what I did incorrectly makes this message appear? And how can I set up my code to test a file's date stamp and process the appropriate files? My code is attached. Thanks in advance for any assistance you can provide.

Sub simpleXlsMerger()
                
'This code opens csv files in a specific location and copies data to a destination xlsx workbook.


Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim folderName As String
Dim UplRow As Long, wkshtNum As Integer, DesRow As Long
Dim dateString As String, StartDate As Date, EndDate As Date
Dim valid As Boolean: valid = False
              
'open folder picker message box
Dim fldr As FileDialog, sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
       .Title = "Select Folder:"
       .AllowMultiSelect = False
       If .Show <> -1 Then GoTo NextCode
       sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
Set dirObj = mergeObj.GetFolder(sItem)
Set filesObj = dirObj.Files


'Set start and end dates of interest
Do Until valid = True
    dateString = Application.InputBox("Enter Start Date (mm/dd/yyyy): ")
    If IsDate(dateString) Then
        StartDate = DateValue(dateString)
        valid = True
        Debug.Print StartDate
    Else
        MsgBox "Invalid start date. Try Again."
        valid = False
        Debug.Print StartDate
    End If
Loop


valid = False


Do Until valid = True
  dateString = Application.InputBox("Enter End Date(mm/dd/yyyy): ")
  If IsDate(dateString) Then
    EndDate = DateValue(dateString)
    valid = True
    Debug.Print EndDate
  Else
    MsgBox "Invalid end date. Try again."
    valid = False
  End If
Loop




For Each everyObj In filesObj


    'If file's date last modified is outside start and end date, get next file
    If everyObj.DateLastModified < StartDate Then
        Exit For
    Else
        If everyObj.DateLastModified > EndDate Then
        Exit For
    End If


    'start date <= date last modified <= endate, so copy rows
    Application.DisplayAlerts = False
    Set bookList = Workbooks.Open(everyObj, ReadOnly:=True, UpdateLinks:=False)
                
    'convert CSV to Excel
    Columns("A:A").Select
    Selection.TextToColumns Destination:=range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
        , 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
        Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
        25, 1)), TrailingMinusNumbers:=True
                        
    'paste in filename
    UplRow = Cells(Rows.Count, 1).End(xlUp).row
    range("z2:z" & UplRow).Value = bookList.Name
             
    wkshtNum = 1
    
    'Test destination workbook for adequate rows and paste upload rows.
    For wkshtNum = 1 To ThisWorkbook.Worksheets.Count
        DesRow = ThisWorkbook.Worksheets(wkshtNum).range("A1048576").End(xlUp).row
        If DesRow + UplRow < 1048576 Then
            bookList.Worksheets(1).range("A2:z" & range("A1048576").End(xlUp).row).Copy
            ThisWorkbook.Worksheets(wkshtNum).range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial
            bookList.Application.CutCopyMode = False
            bookList.Close savechanges:=False
            Exit For
        End If
    Next wkshtNum        'test next worksheet and paste Upload rows there if rows are available


    If DesRow + UplRow > 1048576 Then
       'No other worksheets have space so add worksheet
        ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(wkshtNum - 1)).Name = "Summary" & wkshtNum
        'copy column headers
        ThisWorkbook.Worksheets(1).range("A1:z1").Copy
        ThisWorkbook.Worksheets(wkshtNum).range("A1:Z1").PasteSpecial
        Selection.AutoFilter
        'copy and paste booklist data
        bookList.Worksheets(1).range("A3:Z" & range("A1048576").End(xlUp).row).Copy
        ThisWorkbook.Worksheets(wkshtNum).range("A2:a2").PasteSpecial
        bookList.Application.CutCopyMode = False
        bookList.Close savechanges:=False
    End If
Next everyObj
                
Application.ScreenUpdating = True
Application.DisplayAlerts = True
                
End Sub

 

[Fluff]

Te problem is with the If statement at the start of the loop, it should be like

For Each EveryObj In filesObj


    'If file's date last modified is outside start and end date, get next file
    If EveryObj.DateLastModified < StartDate Then
        Exit For
    ElseIf EveryObj.DateLastModified > EndDate Then
        Exit For
    End If

 

[MAM8433]

Thank You. That did the trick.


'If file's date last modified is outside start and end date, get next file
If EveryObj.DateLastModified < StartDate Then
Exit For
ElseIf EveryObj.DateLastModified > EndDate Then
Exit For
End If
[/CODE][/QUOTE]

 

[Fluff]

Glad to help & thanks for the feedback