Date Loop VBA

[ItalianPlatinum]

Hello,
I have a workbook that runs an extract pull from a system. I have the date to run it as the following formula (=WORKDAY(TODAY(),1,'[HOLIDAYS'!A:A)-1). which works great [got it from another forum here ]. The date will default to current day, on Friday's the day before Monday (Sunday's date) or a Monday if Monday is a holiday and if midweek has a holiday will show the holiday's date.

My dilemma is i am looking for a VBA code sort of similar where on a Friday. The date will re-loop and re-execute for each day as outlined above:

Example:
Mon - thurs (no holidays) run for 1 single day
Fridays (no holidays) - run for Friday, then Saturday then Sunday. STOP
Fridays (with Monday holiday) - run for Friday, then Saturday then Sunday then Monday. STOP
Mid-week holiday when next day is a holiday - run for same day and for next day (holiday). STOP

Any help is really appreciated at the moment I have to run it 3 times. so triple the clicks

 

[ExcelGzh]

I don't know what you mean by "runs an extract pull from a system". The formula in your post looks like a cell formula. How that runs anything I not sure.

However, you need to know the answer to this question "Is tomorrow a working day?" Because if it is the pull won't run tomorrow. So, if tomorrow is a working day, the formula WORKDAY(TODAY(),1,'[HOLIDAYS'!A:A)-1) will give tomorrow's date. Therefore if WORKDAY(TODAY(),1,'[HOLIDAYS'!A:A)-1) = Today()+1 then don't run the pull tomorrow.

 

[ItalianPlatinum]

Right so to clarify I have a VBA. That will run based off a date using that formula. so what I require is that it loops. so run for friday, loop back run for saturday loop back run for sunday. if monday holiday loop back run for Monday.

Right now will only run for the date specified which is formula (=WORKDAY(TODAY(),1,'[HOLIDAYS'!A:A)-1)

 

[ExcelGzh]

The logic is this:
1. Run the pull today
2. Increment the date by 1
3. Is the new date a working day? If No then run the pull. If Yes then stop the process.

Sub RunLoop()
  Dim CurrentDate As Date
  Dim NextWorkingDay As Date
  Dim StopPull As Boolean
  Dim Tomorrow As Date
  
  'Use one of the next two lines
  CurrentDate = Date
  CurrentDate = ThisWorkbook.Sheets("Sheet1").Range("A1")
  NextWorkingDay = Application.WorkDay(CurrentDate, 1, ThisWorkbook.Sheets("Holidays").Range("A:A"))
  Tomorrow = CurrentDate + 1
  StopPull = False
  'Pull will always run at least once
  While Not StopPull
    'Do the pull
    If NextWorkingDay = Tomorrow Then
      StopPull = True
    Else
      CurrentDate = CurrentDate + 1
      NextWorkingDay = Application.WorkDay(CurrentDate, 1, ThisWorkbook.Sheets("Holidays").Range("A:A"))
      Tomorrow = CurrentDate + 1
    End If
  Wend 'Not StopPull
End Sub 'RunLoop

This relies on there being a sheet in the same workbook as this code called Holidays with a list of holiday dates in Column A. You can adjust this to suit your current circumstances

 

[ItalianPlatinum]

Okay let me test. Thank you so much. I will get back to you

 

[JackDanIce]

As alt suggestion and removing IF test on each loop iteration, can also try:

Sub R2D2()
    
    Dim currD   As Date: currD = Date 'currD = sheets("Sheet1").[A1]
    Dim tmwD    As Date: tmwD = currD + 1
    Dim nwD     As Date: nwD = Next_Work_Day(currD)
    
    Do Until tmwD = nwD
        currD = currD + 1
        nwD = Next_Work_Day(currD + 1)
        tmwD = currD + 1
    Loop
    
End Sub

Private Function Next_Work_Day(ByRef currD As Date) As Date

    With Sheets("Holidays")
        Next_Work_Day = Application.WorkDay(currD, 1, .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row))
    End With
    
End Function