Eliminate Weekends and Long weekends

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
89
Hi All,

I have the code below in Red which actually is coded to do something on the 1st of each month. But due to weekends or long weekends, this process is not working and the files are not rolling over whenever the first business day falls on a 2nd 3rd or anything other than the 1st.

Can someone please assist me exclude weekends (Saturday and Sunday) and also long weekends? I can provide the list of holidays if needed

Background is we have an excel report which has a data column in the format mmddyy and the code is looking to see if the mmdd is 01st of the month and then compares to other excel sheet which has worksheet named as 0119 0219.. So whenever it's the 1st of the month, it copies data over from previous month worksheet over to a new worksheet. But what I want is to roll over on the first business day of the month and not just hard coded 01st of the month.

Rich (BB code):
Sub InProcessRecon()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, srcWS As Worksheet, desWS As Worksheet, LastRow As Long, key As Variant, totals As Long, totals1 As Long, totals2 As Long, fVisRow As Long
    Dim RngList As Object, rng As Range, arr As Variant, i As Long, fNames As String, code As Variant, sDate As String, Day1 As String, prevWS As Worksheet
   
    'Source File Sheet name
    Set srcWS = Sheets("QRYLIBA380.CSIPHIST>Sheet1")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    'Opening In Process files based on the value coming from source file
    fNames = "SIGNAPAY LTD IN PROCESS ACCOUN,In Process DDA Recon - SignaPay," & _
             "EPT 6001 IN PROCESS ACCOUNT,In Process DDA Recon - EPS," & _
             "APS IN PROCESS ACCOUNT,In Process DDA Recon - APS," & _
             "PAYMENT WORLD IN PROCESS ACCT,In Process DDA Recon - Payment World," & _
             "TRISOURCE IN PROCESS ACCOUNT,In Process DDA Recon - TriSource," & _
             "BANCTEK SOLUTIONS IN PROCESS,In Process DDA Recon - BancTek," & _
             "MERCHANT BANCARD IN PROCESS,In Process DDA Recon - MBN," & _
             "ADVANCE MERCHANT IN PROCESS AC,In Process DDA Recon - DAS," & _
             "2C PROCESSOR IN PROCESS,In Process DDA Recon - 2CP," & _
             "FRONTLINE IN PROCESS ACCOUNT,In Process DDA Recon - FrontLine," & _
             "TITANIUM PROCESSING IN PROCESS,In Process DDA Recon - Titanium Processing," & _
             "ARGUS MERCHANT IN PROCESS ACCT,In Process DDA Recon - Argus," & _
             "INFINITY CAPTIAL LLC IN PROCES,In Process DDA Recon - Choice," & _
             "TITANIUM PAYMENTS IN PROCESS,In Process DDA Recon - Titanium Payments," & _
             "MERCHANT INDUSTRY2 IN PROCESS,In Process DDA Recon - Merchant Industry," & _
             "UNIFIED PAYMENTS IN PROCESS,In Process DDA Recon - Unified," & _
             "ELECTRONIC MERCHANT SYS IN PRO,In Process DDA Recon - EMS Conversion," & _
             "MAVERICK IN PROCESS ACCOUNT,In Process DDA Recon - Maverick," & _
             "PIVOTAL PAYMENTS IN PROCESS,In Process DDA Recon - Nuvei," & _
             "C&H FINANCIAL SERVICES IN PROC,In Process DDA Recon - C&H," & _
             "MERCHANT LYNX SERVICES IN PROC,In Process DDA Recon - Merchant Lynx," & _
             "EVANCE IN PROCESS,In Process DDA Recon - eVance," & _
             "TSYS IN PROCESS ACCOUNT,In Process DDA Recon - TSYS," & _
         "BANKCARD IN PROCESS ACCOUNT,In Process DDA Recon - BankCard,GRANITE PAYMENT ALLIANCE IN PR,In Process DDA Recon - Granite,AUTOSCRIBE CORP IN PROCESS,In Process DDA Recon - AUTOSCRIBE,TRX SERVICES IN PROCESS ACCT,In Process DDA Recon - TRX Merchant Services"
            
        arr = Split(Application.Trim(fNames), ",")
       
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each rng In srcWS.Range("A2", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp))
        If Not RngList.Exists(rng.Value) Then
            RngList.Add rng.Value, Nothing
        End If
    Next rng
    For Each key In RngList
        For i = 0 To UBound(arr)
            If arr(i) = key Then
                Set wkbDest = Workbooks.Open(ActiveWorkbook.Path & "\" & arr(i + 1) & ".xlsx")
                With srcWS.Cells(1).CurrentRegion
                    .AutoFilter 1, key
                    fVisRow = srcWS.Range("A1", srcWS.Range("A" & srcWS.Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
                    sDate = srcWS.Cells(fVisRow, 4)
                    Day1 = Left(Right(sDate, 4), 2)
                   
                    'Roll over data from previous to Current Month when the month rolls over
                    If Day1 = "01" Then
                        If Left(Left(sDate, Len(sDate) - 4) - 1, 1) < 1 Then
                            Set prevWS = Sheets("0" & Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))
                        Else
                            Set prevWS = Sheets(Left(sDate, Len(sDate) - 4) - 1 & Right(sDate, 2))
                        End If
                        With prevWS
                            Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                            totals = .Range("C:C").Find("Reconciliation Totals").Row
                            totals1 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                            RowCount = totals - 10
                            desWS.Cells(totals1, 1).EntireRow.Resize(RowCount).Insert Shift:=xlDown
                            .Range("A10:I" & totals - 1).Copy desWS.Cells(totals1, 1)
                        End With
totals1:
                        Set desWS = ActiveWorkbook.Sheets(Format(DateSerial(Right(sDate, 2), Left(sDate, Len(sDate) - 4), Mid(sDate, Len(sDate) - 3, 2)), "mmyy"))
                        totals1 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        RowCount = srcWS.[subtotal(103,A:A)] - 1
                        desWS.Cells(totals1, 1).EntireRow.Resize(RowCount).Insert Shift:=xlDown
                        srcWS.Range("D2:D" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 2)
                        totals2 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        For Each rng In desWS.Range("B" & totals1 & ":B" & totals2 - 1)
                            rng = Format(DateSerial(Right(rng, 2), Left(rng, Len(rng) - 4), Mid(rng, Len(rng) - 3, 2)), "mm/dd/yy")
                        Next rng
                        With srcWS
                            .Range("E2:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 5)
                            .Range("F2:F" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 6)
                            .Range("G2:G" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 3)
                            .Range("H2:H" & LastRow).SpecialCells(xlCellTypeVisible).Copy desWS.Cells(totals1, 4)
                        End With
                        srcWS.Cells(1).AutoFilter
                        totals2 = desWS.Range("C:C").Find("Reconciliation Totals").Row
                        With desWS.Range("B10:B" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("C10:C" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("D10:D" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlLeft
                        End With
                        With desWS.Range("E10:E" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                            .HorizontalAlignment = xlCenter
                            .Replace "55", "DR"
                            .Replace "78", "DR"
                            .Replace "18", "CR"
                            .Replace "38", "CR"
                        End With
                        With desWS.Range("F10:F" & totals2 - 1)
                            .Font.Name = "Bookman Old Style"
                            .Font.Color = 10040115
                            .Font.Size = 10
                        End With
                        With desWS
                            For Each code In .Range("E10:E" & totals2 - 1)
                                If code = "DR" Then
                                    If code.Offset(, 1) > 0 Then
                                        code.Offset(, 1) = "-" & code.Offset(, 1)
                                    End If
                                    code.Offset(, 1).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                                ElseIf code = "CR" Then
                                    code.Offset(, 1).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                                End If
                            Next code
                        End With
                        With desWS
                            .Range("G10:I10").Copy
                            .Range("G10:I" & totals2 - 1).PasteSpecial Paste:=xlPasteFormulas
                            .Range("F" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""F10:F""&ROW()-1))"
                            .Range("G" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""G10:G""&ROW()-1))"
                            .Range("H" & totals2).FormulaR1C1 = "=SUM(INDIRECT(""H10:H""&ROW()-1))"
                        End With
                    Else
                        GoTo totals1
                    End If
                End With
            End If
        Next i
        wkbDest.Close True
    Next key
    MsgBox ("In Process recon job completed successfully.  Please check the Files.")
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,980
I have a table of holidays. Then when I scan thru the dates, it ignores those if in the holiday list, and if the date is a weekend:

Code:
public sub ScanDates()
dim colHolidays as new collection

On Error GoTo errBadDates
   'fill colHolidays from list
Set colHolidays = FillHolidayList()  'fill your holidays here

'scan thru all date range
vStartDate = "12/18/2019"
vEndDate = "12/24/2019"
vDate = vStartDate
While CDate(vDate) <= CDate(vEndDate)
   If Format(vDate, "w") = vbSaturday Or Format(vDate, "w") = vbSunday Then
      'ignore weekend
       Debug.Print "weekend: " & vDate
   Else
      sDte = vDate
      If colHolidays(sDte) = CStr(vDate) Then
           'ignore holidays
             Debug.Print "holiday: " & vDate
       Else
goodDate: 'process date here
            Debug.Print vDate
       End If
   End If
    vDate = DateAdd("d", 1, vDate)  'get next date
Wend
Exit Sub
errBadDates:
If Err = 5 Then Resume goodDate
End Sub
 

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
89
Hi @ranman256 Where would you fit the code into mine?Also Can I hard code the holiday list inside the VBA ? Users run this via Macro. They don't have like a form or anything.
 

babar2019

Board Regular
Joined
Jun 21, 2019
Messages
89
Hi,

In the above code, Currently the macro copies the previous worksheet data into a new worksheet whenever it sees the day as "01".

Is there a way the user can change this manually every month based on whatever the first business day it is from "01" to "02" or "03" etc and the macro will still run fine?
I'm testing it on a file where the source file will have a date of "010220" because "02" is the first business day for January 2020, The macro does not roll the data over from "1219" worksheet over to "0120" worksheet.

Can you please help?
 

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,980
you could use 2 cells on a screen to enter the startdate / enddate
b2=startdate
b3 = enddate
the list of holidays in another cell range ,i.e: H:1-99
click button to run the macro.

then adjust code:
'scan thru all date range
vStartDate = range("B2").value
vEndDate = range("B3").value
 

Watch MrExcel Video

Forum statistics

Threads
1,130,032
Messages
5,639,646
Members
417,102
Latest member
bcselect

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