Exclude Non-Working Hours Using NetworkDays.Intl As A Complex Formula In Excel VBA?

As the posted Formula accurately returns the working hours between the DC_CREATION_DATE and the ACTUAL_END_DATE, the problem seems to be about how to enter an Excel formula using VBA.

Op’s Formula:

= ( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]], [@[ACTUAL_END_DATE]], "0000000" ) -1 ) * ( Upper - Lower )
 + IF( NETWORKDAYS.INTL( [@[ACTUAL_END_DATE]], [@[ACTUAL_END_DATE]], "0000000" ),
 MEDIAN( MOD( [@[ACTUAL_END_DATE]], 1 ), Upper, Lower ), Upper )
 - MEDIAN( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]], [@[DC_CREATION_DATE]], "0000000" )
 * MOD( [@[DC_CREATION_DATE]], 1 ), Upper, Lower )

The formula above seems to be obtained from an Excel Table (i.e. ListObject) as indicated by these parameters: [@[DC_CREATION_DATE]] and [@[ACTUAL_END_DATE]], while Upper and Lower seems to corresponds to Defined Names

The same formula using standard cells as parameters would be something like this:

= ( NETWORKDAYS.INTL( B7, C7, "0000000" ) -1 ) * ( Upper - Lower )
 + IF( NETWORKDAYS.INTL( C7, C7, "0000000" ),
 MEDIAN( MOD( C7, 1 ), Upper, Lower ), Upper )
 - MEDIAN( NETWORKDAYS.INTL( B7, B7, "0000000" )
 * MOD( B7, 1 ), Upper, Lower )

Note that the parameters: [@[DC_CREATION_DATE]] and [@[ACTUAL_END_DATE]] are replaced by the cells B7 and C7 respectively

And that’s the problem with the Op’s code:

• it’s not replacing the entire parameters

  • Replacing only @[DC_CREATION_DATE] instead of [@[DC_CREATION_DATE]]
  • Replacing only @[ACTUAL_END_DATE] instead of [@[ACTUAL_END_DATE]]

• Additionally it’s also wrapping Upper and Lower with [ and ]

Processing Excel Formulas with VBA:

I would suggest to add a validation of the DC_CREATION_DATE and ACTUAL_END_DATE at the beginning of the formula as follows:

= IF( [@[ACTUAL_END_DATE]] < [@[DC_CREATION_DATE]], 0,
 ( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]], [@[ACTUAL_END_DATE]], "0000000" ) -1 ) * ( Upper - Lower )
 + IF( NETWORKDAYS.INTL( [@[ACTUAL_END_DATE]], [@[ACTUAL_END_DATE]], "0000000" ),
 MEDIAN( MOD( [@[ACTUAL_END_DATE]], 1 ), Upper, Lower ), Upper )
 - MEDIAN( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]], [@[DC_CREATION_DATE]], "0000000" )
 * MOD( [@[DC_CREATION_DATE]], 1 ), Upper, Lower ) )

I propose the following method to process excel formulas using VBA:

1. Substitute the parameters in the formula by key words that will be replaced by the R1C1 reference of the actual values when running the procedure:

…

= IF( #END < #INI, 0," & vbLf & _
 ( NETWORKDAYS.INTL( #INI, #END, "0000000" ) -1 ) * ( #UPR - #LWR )" & vbLf & _
 + IF( NETWORKDAYS.INTL( #END, #END, "0000000" )," & vbLf & _
 MEDIAN( MOD( #END, 1 ), #UPR, #LWR ), #UPR )" & vbLf & _
 - MEDIAN( NETWORKDAYS.INTL( #INI, #INI, "0000000" )" & vbLf & _
 * MOD( #INI, 1 ), #UPR, #LWR ) )"

Where:
#INI = [@[DC_CREATION_DATE]]
#END = [@[ACTUAL_END_DATE]]
#LWR = Lower
#UPR = Upper

By using the R1C1 reference of the cells we can update the formulas for the entire range at once instead of looping over each cell.

2. Define a constant to hold the formula template:

…

Const kFmlHours As String = "= IF( #END < #INI, 0," & vbLf & _
    " ( NETWORKDAYS.INTL( #INI, #END, ""0000000"" ) -1 ) * ( #UPR - #LWR )" & vbLf & _
    " + IF( NETWORKDAYS.INTL( #END, #END, ""0000000"" )," & vbLf & _
    " MEDIAN( MOD( #END, 1 ), #UPR, #LWR ), #UPR )" & vbLf & _
    " - MEDIAN( NETWORKDAYS.INTL( #INI, #INI, ""0000000"" )" & vbLf & _
    " * MOD( #INI, 1 ), #UPR, #LWR ) )"

3. Define variables for the parameters as required:

…

Dim sFmlHours As String
Dim TimeLwr As Double, TimeUpr As Double
Dim sDateIni As String, sDateEnd As String

4. Replace the key words in the formula template with the corresponding values or the R1C1 reference:

…

        With .Range("V2")
            sDateIni = Range("N2").Address(0, 1, xlR1C1, False, .Cells)
            sDateEnd = Range("R2").Address(0, 1, xlR1C1, False, .Cells)
            sFmlHours = kFmlHours
            sFmlHours = Replace(sFmlHours, "#INI", sDateIni)
            sFmlHours = Replace(sFmlHours, "#END", sDateEnd)
            sFmlHours = Replace(sFmlHours, "#LWR", TimeLwr)
            sFmlHours = Replace(sFmlHours, "#UPR", TimeUpr)
        End With

5. Enter the formula for the entire range, (you can also replace the formulas with the resulting value):

…

        With .Range("V2:V" & lRow)
            .FormulaR1C1 = sFmlHours    'Enter formula
            .Value = .Value             'Replace Formula with Value
        End With

Procedure:

This procedure only includes the calculation of the working hours:

Sub Formula_Working_Hours()
   
Const kFmlHours As String = "= IF( #END < #INI, 0," & vbLf & _
    " ( NETWORKDAYS.INTL( #INI, #END, ""0000000"" ) -1 ) * ( #UPR - #LWR )" & vbLf & _
    " + IF( NETWORKDAYS.INTL( #END, #END, ""0000000"" )," & vbLf & _
    " MEDIAN( MOD( #END, 1 ), #UPR, #LWR ), #UPR )" & vbLf & _
    " - MEDIAN( NETWORKDAYS.INTL( #INI, #INI, ""0000000"" )" & vbLf & _
    " * MOD( #INI, 1 ), #UPR, #LWR ) )"

Dim wsMain As Worksheet, wsPrcs As Worksheet
Dim sFmlHours As String
Dim TimeLwr As Double, TimeUpr As Double
Dim sDateIni As String, sDateEnd As String
Dim lRow As Long
    
    Rem Set Lower & Upper Time
    TimeLwr = TimeSerial(8, 0, 0)
    TimeUpr = TimeSerial(23, 0, 0)
    
    With ThisWorkbook
        Set wsMain = .Sheets("RAW DATA")
        Set wsPrcs = .Sheets("Processed Data")
    End With
    
    lRow = wsMain.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
    
    With wsPrcs
                
        .Activate
        If Not (.AutoFilter Is Nothing) Then .AutoFilter.Range.AutoFilter
            
        Rem Set Formula
        With .Range("V2")
            sDateIni = Range("N2").Address(0, 1, xlR1C1, False, .Cells)
            sDateEnd = Range("R2").Address(0, 1, xlR1C1, False, .Cells)
            sFmlHours = kFmlHours
            sFmlHours = Replace(sFmlHours, "#INI", sDateIni)
            sFmlHours = Replace(sFmlHours, "#END", sDateEnd)
            sFmlHours = Replace(sFmlHours, "#LWR", TimeLwr)
            sFmlHours = Replace(sFmlHours, "#UPR", TimeUpr)
        End With
        
        Rem Enter Formula
        With .Range("V2:V" & lRow)
            .FormulaR1C1 = sFmlHours    'Enter formula
            .Value = .Value             'Replace Formula with Value
        End With
        
    End With

End Sub

There's a potential flaw here:

For Each i In Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible)
        StartDate = Range("N" & k).Value
        EndDate = Range("R" & k).Value
        Debug.Print (StartDate)
        Debug.Print (EndDate)
        Range("U" & k).Value = DateDiff("s", Range("N" & k).Value, Range("R" & k).Value)
        Range("V" & k).Value = "=(NETWORKDAYS.INTL([" & StartDate & "],[" & EndDate & "],""0000000"")-1)*([" & upper & "]- [" & lower & "])" _
                                    & "+IF(NETWORKDAYS.INTL([" & EndDate & "],[" & EndDate & "],""0000000""),MEDIAN(MOD([" & EndDate & "],1),[" & upper & "],[" & lower & "]),[" & upper & "])" _
                                    & "-MEDIAN(NETWORKDAYS.INTL([" & StartDate & "],[" & StartDate & "],""0000000"")*MOD([" & StartDate & "],1),[" & upper & "],[" & lower & "])"
        k = k + 1
Next i

You're looping over visible cells in Col N, so I'm assuming there's some filter applied here, and some rows are hidden.

If the very first row (#2) is hidden then you'll start with i=N3 but your k value will still be 2, so you're reading from/writing to a different row from the one you want.

Within the loop, i.EntireRow will give you each visible row, so you can work with (eg)

Dim rw As Range
'....
For Each i In Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible)
    Set rw = i.EntireRow
    StartDate = rw.Columns("N").Value 'or just i.Value...
    EndDate = rw.Columns("R").Value
    'etc etc

Late reply, but take a look.

Sub RAWDATA_SORT()
    
    Dim Main As Worksheet, Processed As Worksheet
    Dim LastRow As Long, col As Long, k As Integer
    Dim colName As String, maincolName As String
    Dim i As Long
    Dim Headers As Range, SearchHeaders As Range
    Dim upper As Date, lower As Date, StartDate As Date, EndDate As Date
    
    Dim vR(), vTime()
    
    
    'On Error Resume Next
    Set Main = Sheets("RAW DATA")
    'Main.Name = "RAW DATA"
    'Sheets.Add(After:=Sheets("RAW DATA")).Name = "Processed Data"
    Set Processed = Sheets("Processed Data")
    'Main.Activate
    If Main.FilterMode Then
        Main.ShowAllData
    End If
    Set Headers = Main.Range("1:1")
    LastRow = 0
    'lower = Format(TimeValue("08:00 AM"), "hh:mm AMPM")
    'upper = Format(TimeValue("11:00 PM"), "hh:mm AMPM")
    'Debug.Print (lower)
    'Debug.Print (upper)
    
    ' More Code Here
    
    With Processed
       ' .Activate
        .AutoFilterMode = False
        If .FilterMode Then
            .ShowAllData
        End If
    End With
    ' More Code Here
    'LastRow = Main.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
    LastRow = Main.Range("n" & Rows.Count).End(xlUp).Row
    
    ReDim vR(1 To LastRow, 1 To 1)
    ReDim vTime(1 To LastRow, 1 To 2)
    
    Dim rngDB As Range, vDB
   
    Set rngDB = Main.Range("n2", "R" & LastRow)
    vDB = rngDB
    For i = 1 To UBound(vDB, 1)
        vTime(i, 2) = DayWorkTime(vDB(i, 1), vDB(i, 5))
        vTime(i, 1) = vTime(i, 2) * 24 * 3600
    Next i
        
    With Processed
        .Range("U2").Resize(UBound(vR), 2) = vTime
        .Range("u:u").NumberFormat = "#,##0"
        .Range("v:v").NumberFormat = "[H]:mm"
    End With
    

End Sub

Function DayWorkTime(stime, etime)
    Dim Start As Date, EndTime As Date
    Dim vTime()
    Dim i As Long, k As Integer
    Dim n As Integer
    
    Application.Volatile (0)
 
    If stime > etime Then
        etime = etime + 1
    End If
    k = Int(etime) - Int(stime)
    
    For i = 0 To k
        n = n + 1
        ReDim Preserve vTime(1 To 2, 1 To n)
        If i = 0 Then
            vTime(1, n) = stime - Int(stime)
            vTime(2, n) = 1
        ElseIf k >= 1 Then
            If i = k Then
                vTime(1, n) = 0
                vTime(2, n) = etime - Int(etime)
            Else
                vTime(1, n) = 0
                vTime(2, n) = 1
            End If
        End If
    Next i
        
    For i = 1 To n
        DayWorkTime = DayWorkTime + DayWork(vTime(1, i), vTime(2, i))
    Next i
End Function
Function DayWork(stime, etime)
    Dim DaySt, DayEt
    Dim Start As Date, EndTime As Date
    
    Application.Volatile (0)
    DaySt = TimeSerial(8, 0, 0)
    DayEt = TimeSerial(23, 0, 0)
    With WorksheetFunction
        Start = .Max(stime, DaySt)
        EndTime = .Min(etime, DayEt)
    End With
    If Start > EndTime Then Exit Function
    DayWork = EndTime - Start
End Function

I did it simply by using excel formulas and is working fine with sample data I populated

Sample data and Result

Formula used in cell C2

=(NETWORKDAYS.INTL(A2,B2,"0000000")-2)*15
+IF(TIME(23,0,0)-TIME(HOUR(A2),MINUTE(A2),0)>=TIME(15,0,0),TIME(15,0,0),IF(TIME(HOUR(A2),MINUTE(A2),0)<TIME(23,0,0),TIME(23,0,0)-TIME(HOUR(A2),MINUTE(A2),0),0))*24
+IF(TIME(HOUR(B2),MINUTE(B2),0)-TIME(8,0,0)>=TIME(15,0,0),TIME(15,0,0),IF(TIME(HOUR(B2),MINUTE(B2),0)>TIME(8,0,0),TIME(HOUR(B2),MINUTE(B2),0)-TIME(8,0,0),0))*24

Formula used in cell D2

=ROUNDDOWN(C2/15,0)&" Days "&ROUNDDOWN(MOD(C2,15),0)&" Hours "& MOD(C2,1)*60 & " Minutes"

What I am trying to do is convert working duration excluding start and finish date by multiplying them with 15hrs. For hours worked in Start date and finish date, i am checking if its in between 08:00 and 23:00 hrs. and the hours worked.

After I get the total I again convert them from total hours to days, hours, and minutes by dividing them by 15 for days, remainder for hours and minutes