Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Public BV As New BedvitCOM.VBA
'==================================================================================================
Sub TestFilter()
Dim x, aT, aP, aL, s$

    ' Get Arr2D of Table ------------------------
    aT = ActiveSheet.ListObjects(1).DataBodyRange.Value2


    ' Choose ONE(out of 6) Variant --------------
    ' 1. Col5 is NOT Equal "1U rack" (Col5 is Equal "2U rack" because there are only 2 Values in Col5)
    If Not BV_Filter_GetParams_ByStr_OneLogic(aP, "5<>1", "1U rack", , , True) Then Stop: End

    ' 2. Col2 have "e" AND Col2 have "n". Intel,Lenovo.
    If Not BV_Filter_GetParams_ByStr_OneLogic_OneCol(aP, "i1 i2", Array("e", "n"), False, 2, , True) Then Stop: End

    ' 3. Col2 have "d/D" OR Col2 have "i/I"(CaseIgnore). Dell,Intel.
    If Not BV_Filter_GetParams_ByStr_OneLogic_OneCol(aP, "ic1 ic2", Array("D", "I"), True, 2, , True) Then Stop: End

    ' 4. Col2 = "Dell" AND Col4 Like "LGA ####".
    If Not BV_Filter_GetParams_ByStr_OneLogic(aP, "2=1 4L2", Array("Dell", "LGA ####"), False, , True) Then Stop: End

    ' 5. Col2 = "HPE" OR Col4 Like "LGA 1*".
    If Not BV_Filter_GetParams_ByStr_OneLogic(aP, "2=1 4L2", Array("HPE", "LGA 1*"), True, , True) Then Stop: End

    ' 6. ( Col2 = "Dell" And Col4 Like "LGA 1*" ) Or ( Col2 = "HPE" And Col5 Not Like "2*" )
    x = Array("Dell", "LGA 1*", "HPE", "2*")
    s = "((2=1) A (4L2)) O ((2=3) A (5NL4))"
    If Not BV_Filter_GetParams_ByStr(aP, s, x, , True) Then Stop: End

    ' Filter ------------------------------------
    If (BV_Filter_Run(aT, aP, aL, , True, True) <> 1) Then Exit Sub ' Include Msgs if not Full


    ' Load on Sheet -----------------------------
    [N2:R200].ClearContents
    [N2].Resize(UBound(aL, 1), UBound(aL, 2)).Value2 = aL

    MsgBox "Load Rows: " & Format$(UBound(aL, 1), "#,#") & " out of " & Format$(UBound(aT, 1), "#,#"), vbInformation, "DONE"
End Sub
'==================================================================================================

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Enum e_BV_Filt_Logic
    Or_ = 0         ' O(79)
    And_ = 1        ' A(65)
End Enum
'==================================================================================================
Enum e_BV_Filt_Oper
    Less = 1        ' <(60) Min
    Equal = 2       ' =(61)
    More = 4        ' >(62)
    InStr_ = 8      ' I(73)
    RegExp = 16     ' R(82) Max
    CaseIgnore = 32 ' C(67)
    Basic = 64      '
    Extended = 128  '
    Like_ = 256     ' L(76)
    Not_ = 512      ' N(78)
End Enum
'==================================================================================================
'==================================================================================================
'==================================================================================================
Private Function IsIntPosit(ByVal vIn, vIntOut, Optional AllowZero As Boolean) As Boolean

    If Not IsNumeric(vIn) Then Exit Function
    vIn = --vIn
    If (vIn <> Fix(vIn)) Then Exit Function
    
    If AllowZero Then
        If (vIn < 0) Then Exit Function
    Else
        If (vIn < 1) Then Exit Function
    End If

    vIntOut = vIn: IsIntPosit = True
End Function
'==================================================================================================
'==================================================================================================
'==================================================================================================
Private Function ReqFix(sIn$, sOutIn$, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim s$, i&
Static st&, REa As RegExp, REl As RegExp, REr As RegExp, REd As RegExp

    If (st = 0) Then
        st = 1
        Set REa = New RegExp: REa.Global = True: REa.Pattern = "([()])"
        Set REl = New RegExp: REl.Global = True: REl.Pattern = "(\d)(\D)"
        Set REr = New RegExp: REr.Global = True: REr.Pattern = "(\D)(\d)"
        Set REd = New RegExp: REd.Global = True: REd.Pattern = "([()]) ([()])"
    End If

    s = UCase$(BV.Trim(sIn))

    If (s Like "*[! ()0-9<=>ACILNOR]*") Then
        If MsgFalse Then MsgBox "RequestString" & vbLf & "«" & sIn & "»" & vbLf & vbLf & "contain BAD Symbol!", vbCritical, "BV_Filter_GetParams(ReqFix)"
        Exit Function
    End If

    Do
        i = InStr(s, "<>"): If (i = 0) Then Exit Do
        Mid$(s, i, 2) = "N="
    Loop

    s = REa.Replace$(s, " $1 ")
    s = REl.Replace$(s, "$1 $2")
    s = REr.Replace$(s, "$1 $2")
    s = BV.Trim(s)
    s = REd.Replace$(s, "$1$2")

    If MsgTrue Then MsgBox "RequestString" & vbLf & "«" & sIn & "»" & vbLf & vbLf & "was succsessfully transformed to" & vbLf & "«" & s & "»", vbInformation, "BV_Filter_GetParams(ReqFix)"
    ReqFix = True: sOutIn = s
End Function
'--------------------------------------------------------------------------------------------------
Private Sub Test_ReqFix()
Dim s$
    s = "( (2=>1)a(4l2) )o( (2<=3)a(5nl4) )"
    ReqFix s, s, True, True ' «(( 2 => 1 ) A ( 4 L 2 )) O (( 2 <= 3 ) A ( 5 NL 4 ))»
End Sub
'==================================================================================================
'==================================================================================================
Private Function UnCode(sIn$, vOut&, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim s$, n&, c&, p&
Static st&, a&()

    If (st = 0) Then
        st = 1: ReDim a(82)

        For n = 1 To UBound(a)
            a(n) = -1
        Next n

        a(60) = 1   ' <
        a(61) = 2   ' =
        a(62) = 4   ' >
        a(65) = 1   ' A: And(Logic)
        a(67) = 32  ' C: CaseIgnore
        a(73) = 8   ' I: InStr
        a(76) = 256 ' L: Like
        a(78) = 512 ' N: Not
        a(79) = 0   ' O: Or(Logic)
        a(82) = 16  ' R: RegExp
    End If
    
    If (sIn = "") Then
        If MsgFalse Then MsgBox "Code is EMPTY!", vbCritical, "BV_Filter_GetParams(UnCode)"
        Exit Function
    End If

    vOut = 0: p = -1
    On Error Resume Next

    For n = 1 To Len(sIn)
        c = BV.UnicodeCharCodeGet(sIn, n): p = a(c)

        If (p = -1) Then
            If MsgFalse Then MsgBox "Char «" & ChrW$(c) & "» is NOT Correct!", vbCritical, "BV_Filter_GetParams(UnCode)"
            Exit Function
        End If

        vOut = vOut + p: p = -1
    Next n

    UnCode = True
    If MsgTrue Then MsgBox "Code «" & sIn & "» is Correct and calculate to number «" & vOut & "»", vbInformation, "BV_Filter_GetParams(UnCode)"
End Function
'--------------------------------------------------------------------------------------------------
Private Sub Test_UnCode()
Dim n&
    UnCode "NL", n, True, True
End Sub
'==================================================================================================
'==================================================================================================
' Checks
'==================================================================================================
Private Function Ch1_Logic(aReq, nPos&, vOut, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim s$, n&
    s = aReq(nPos): If Not UnCode(s, n, , MsgFalse) Then GoTo er
    If ((n <> 0) And (n <> 1)) Then GoTo er
    
    If MsgTrue Then MsgBox "Argument «sReq» contain Correct Logic «" & s & "(" & n & ")»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbInformation, "BV_Filter_GetParams_ByStr(Ch1_Logic)"
    vOut = n: Ch1_Logic = True: Exit Function

er: If MsgFalse Then MsgBox "Argument «sReq» contain BAD Logic «" & s & "»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbCritical, "BV_Filter_GetParams_ByStr(Ch1_Logic)"
End Function
'==================================================================================================
Private Function Ch2_Brackets(aReq, nPos&, vOut, Optional RightBracket As Boolean, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim s$

    s = aReq(nPos)

    If RightBracket Then
        If (s Like "*[!)]*") Then GoTo er
    Else
        If (s Like "*[!(]*") Then GoTo er
    End If

    If MsgTrue Then MsgBox "Argument «sReq» contain Correct Bracket(s) «" & s & "»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbInformation, "BV_Filter_GetParams_ByStr(Ch2_Brackets)"
    vOut = s: Ch2_Brackets = True: Exit Function

er: If MsgFalse Then MsgBox "Argument «sReq» contain BAD Bracket(s) «" & s & "»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbCritical, "BV_Filter_GetParams_ByStr(Ch2_Brackets)"
End Function
'==================================================================================================
Private Function Ch3_ColNum(aReq, nPos&, vOut, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim s$, n&

    s = aReq(nPos): If Not IsIntPosit(s, n) Then GoTo er

    If MsgTrue Then MsgBox "Argument «sReq» contain Correct ColNum «" & n & "»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbInformation, "BV_Filter_GetParams_ByStr(Ch3_ColNum)"
    vOut = n: Ch3_ColNum = True: Exit Function

er: If MsgFalse Then MsgBox "Argument «sReq» contain BAD ColNum «" & s & "»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbCritical, "BV_Filter_GetParams_ByStr(Ch3_ColNum)"
End Function
'==================================================================================================
Private Function Ch4_ParamCode(aReq, nPos&, vOut, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim s$, n&

    s = aReq(nPos): If Not UnCode(s, n, , MsgFalse) Then GoTo er

    If MsgTrue Then MsgBox "Argument «sReq» contain Correct CodeParam «" & s & "(" & n & ")»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbInformation, "BV_Filter_GetParams_ByStr(Ch4_ParamCode)"
    vOut = n: Ch4_ParamCode = True: Exit Function

er: If MsgFalse Then MsgBox "Argument «sReq» contain BAD CodeParam «" & s & "»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbCritical, "BV_Filter_GetParams_ByStr(Ch4_ParamCode)"
End Function
'==================================================================================================
Private Function Ch5_ArrIndex(aReq, nPos&, vOut, aVal, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim s$, n&, UBnd&

    s = aReq(nPos): If Not IsIntPosit(s, n) Then GoTo er
    UBnd = UBound(aVal): If (n > UBnd) Then GoTo er

    If MsgTrue Then MsgBox "Argument «sReq» contain Correct ArrIndex «" & n & "»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbInformation, "BV_Filter_GetParams_ByStr(Ch5_ArrIndex)"
    vOut = aVal(n): Ch5_ArrIndex = True: Exit Function

er: If MsgFalse Then MsgBox "Argument «sReq» contain BAD ArrIndex «" & s & "»" & vbLf & vbLf & "«" & Join(aReq) & "»", vbCritical, "BV_Filter_GetParams_ByStr(Ch5_ArrIndex)"
End Function
'==================================================================================================
'==================================================================================================
' Prepare
'==================================================================================================
Private Function Prepare(sReq_InOut$, aSpl_Out, DivBy236&, a1D_ValForReq, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean

    If Not ReqFix(sReq_InOut, sReq_InOut, , MsgFalse) Then Exit Function
    If (DivBy236 = 6) Then sReq_InOut = "A " & sReq_InOut
    aSpl_Out = Split(sReq_InOut): BV.ArrayReDim aSpl_Out, 1

    If ((UBound(aSpl_Out) Mod DivBy236) <> 0) Then
        If MsgFalse Then MsgBox "Argument «sReq» is NOT Divisible by " & DivBy236 & "!" & vbLf & "«" & sReq_InOut & "»", vbCritical, "BV_Filter_GetParams_ByStr(Prepare)"
        Exit Function
    End If

    If Not IsArray(a1D_ValForReq) Then a1D_ValForReq = Array(a1D_ValForReq)
    BV.ArrayReDim a1D_ValForReq, 1

    Prepare = True
    If MsgTrue Then MsgBox "Argument «sReq» was successfully Prepared" & vbLf & vbLf & "«" & sReq_InOut & "»", vbInformation, "BV_Filter_GetParams_ByStr(Prepare)"
End Function
'==================================================================================================
'==================================================================================================
' GetParams_ByStr
'==================================================================================================
' Rule:             (Col2 = "Dell" And Col4 Like "LGA 1*") Or (Col2 = "HPE" And Col5 Not Like "2*")
' Tens:              0  0 0 0 0 0 0 0 0 1 1  1 1  1 1 1 1 1 1 2 2  2 2      Total: 23 + 1 = 24. 24 Mod 6 = 0. 24 / 6 = 4 Rows in a2D_Par_Out
' Units:             1  2 3 4 5 6 7 8 9 0 1  2 3  4 5 6 7 8 9 0 1  2 3

' sReq(Perfect):    "(( 2 = 1 ) A ( 4 L 2 )) O (( 2 = 3 ) A ( 5 NL 4 ))"
' sReq(can be):     "( (2=1)a(4l2) )o( (2=3)a(5nl4) )"
' a1D_ValForReq:    Array("Dell", "LGA 1*", "HPE", "2*")

' Tens:              0 0  0 0  0 0 0 0 0 1 1 1  1 1  1 1  1 1 1 2 2 2  2 2   Total: 24
' Units:             1 2  3 4  5 6 7 8 9 0 1 2  3 4  5 6  7 8 9 0 1 2  3 4

' sReq(transform):  "A (( 2 => 1 ) A ( 4 L 2 )) O (( 2 <= 3 ) A ( 5 NL 4 ))"
Function BV_Filter_GetParams_ByStr(a2D_Par_Out, ByVal sReq$, ByVal a1D_ValForReq, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim x, spl, s$, r&, n&, p&, UBnd&

    If Not Prepare(sReq, spl, 6, a1D_ValForReq, , MsgFalse) Then Exit Function
    ReDim a2D_Par_Out(UBound(spl) / 6, 6)

    For r = 1 To UBound(a2D_Par_Out, 1)
        If Not Ch1_Logic(spl, n + 1, a2D_Par_Out(r, 1), , MsgFalse) Then Exit Function
        If Not Ch2_Brackets(spl, n + 2, a2D_Par_Out(r, 2), False, , MsgFalse) Then Exit Function
        If Not Ch3_ColNum(spl, n + 3, a2D_Par_Out(r, 3), , MsgFalse) Then Exit Function
        If Not Ch4_ParamCode(spl, n + 4, a2D_Par_Out(r, 4), , MsgFalse) Then Exit Function
        If Not Ch5_ArrIndex(spl, n + 5, a2D_Par_Out(r, 5), a1D_ValForReq, , MsgFalse) Then Exit Function
        If Not Ch2_Brackets(spl, n + 6, a2D_Par_Out(r, 6), True, , MsgFalse) Then Exit Function

        n = n + 6
    Next r

    BV_Filter_GetParams_ByStr = True
    If MsgTrue Then MsgBox "2D-Array (Rows: " & Format$(UBound(a2D_Par_Out, 1), "#,#") & ") with Parameters for BV.ArrayFilterV was successfully created!", vbInformation, "BV_Filter_GetParams_ByStr"
End Function
'--------------------------------------------------------------------------------------------------
' Rule: ( (Col2 = "Dell") And (Col4 Like "LGA 1*") ) Or ( (Col2 = "HPE") And (Col5 Not Like "2*") )
Private Sub Test_BV_Filter_GetParams_ByStr()
Dim a, s$

    s = "( (2=1)a(4l2) )o( (2=3)a(5nl4) )"
    a = Array("Dell", "LGA 1*", "HPE", "2*")

    If Not BV_Filter_GetParams_ByStr(a, s, a, True, True) Then Exit Sub
    Worksheets.add After:=ActiveSheet
    [a1].Value2 = s
    [a4].Resize(UBound(a, 1), UBound(a, 2)).Value2 = a
    
    a = Array("Logic", "(", "ColNum", "CodeParam", "Value", ")")
    [A3].Resize(1, UBound(a)).Value2 = a
End Sub
'==================================================================================================
'==================================================================================================
' Rule:             Col2 = "Dell" And Col4 Like "LGA 1*"
' sReq(Perfect):    "2 = 1 4 L 2"                        ' Must be Divisible by 3
' sReq(can be):     "2=1 4L2"
Function BV_Filter_GetParams_ByStr_OneLogic(a2D_Par_Out, ByVal sReq$, ByVal a1D_ValForReq, Optional UseOR As Boolean, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim spl, s$, r&, n&, logic&

    If Not Prepare(sReq, spl, 3, a1D_ValForReq, , MsgFalse) Then Exit Function
    If Not UseOR Then logic = 1     ' 0 is Or, 1 is And (As Default)
    ReDim a2D_Par_Out(UBound(spl) / 3, 6)

    For r = 1 To UBound(a2D_Par_Out, 1)
        a2D_Par_Out(r, 1) = logic
        a2D_Par_Out(r, 2) = "("
        If Not Ch3_ColNum(spl, n + 1, a2D_Par_Out(r, 3), , MsgFalse) Then Exit Function
        If Not Ch4_ParamCode(spl, n + 2, a2D_Par_Out(r, 4), , MsgFalse) Then Exit Function
        If Not Ch5_ArrIndex(spl, n + 3, a2D_Par_Out(r, 5), a1D_ValForReq, , MsgFalse) Then Exit Function
        a2D_Par_Out(r, 6) = ")"

        n = n + 3
    Next r

    BV_Filter_GetParams_ByStr_OneLogic = True
    If MsgTrue Then MsgBox "2D-Array (Rows: " & Format$(UBound(a2D_Par_Out, 1), "#,#") & ") with Parameters for BV.ArrayFilterV was successfully created!", vbInformation, "BV_Filter_GetParams_ByStr_OneLogic"
End Function
'--------------------------------------------------------------------------------------------------
' Rule: Col2 = "Dell" And Col4 Like "LGA 1*"
Private Sub Test_BV_Filter_GetParams_ByStr_OneLogic()
Dim a, s$

    s = "2=1 4L2"
    a = Array("Dell", "LGA 1*")

    If Not BV_Filter_GetParams_ByStr_OneLogic(a, s, a, , True, True) Then Exit Sub
    Worksheets.add After:=ActiveSheet
    [a1].Value2 = s
    [a4].Resize(UBound(a, 1), UBound(a, 2)).Value2 = a
    
    a = Array("Logic", "(", "ColNum", "CodeParam", "Value", ")")
    [A3].Resize(1, UBound(a)).Value2 = a
End Sub
'==================================================================================================
'==================================================================================================
' Rule:             Col2 = "Dell" And Col2 Like "LGA 1*"
' sReq(Perfect):    "= 1 L 2"                        ' Must be Divisible by 2
' sReq(can be):     "=1 L2"
Function BV_Filter_GetParams_ByStr_OneLogic_OneCol(a2D_Par_Out, ByVal sReq$, ByVal a1D_ValForReq, Optional UseOR As Boolean, Optional ColNum& = 1, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim spl, s$, r&, n&, logic&

    If Not Prepare(sReq, spl, 2, a1D_ValForReq, , MsgFalse) Then Exit Function
    If Not UseOR Then logic = 1     ' 0 is Or, 1 is And (As Default)
    ReDim a2D_Par_Out(UBound(spl) / 2, 6)

    For r = 1 To UBound(a2D_Par_Out, 1)
        a2D_Par_Out(r, 1) = logic
        a2D_Par_Out(r, 2) = "("
        a2D_Par_Out(r, 3) = ColNum
        If Not Ch4_ParamCode(spl, n + 1, a2D_Par_Out(r, 4), , MsgFalse) Then Exit Function
        If Not Ch5_ArrIndex(spl, n + 2, a2D_Par_Out(r, 5), a1D_ValForReq, , MsgFalse) Then Exit Function
        a2D_Par_Out(r, 6) = ")"

        n = n + 2
    Next r

    BV_Filter_GetParams_ByStr_OneLogic_OneCol = True
    If MsgTrue Then MsgBox "2D-Array (Rows: " & Format$(UBound(a2D_Par_Out, 1), "#,#") & ") with Parameters for BV.ArrayFilterV was successfully created!", vbInformation, "BV_Filter_GetParams_ByStr_OneLogic_OneCol"
End Function
'--------------------------------------------------------------------------------------------------
' Rule: Col2 = "Dell" And Col2 Like "LGA 1*"
Private Sub Test_BV_Filter_GetParams_ByStr_OneLogic_OneCol()
Dim a, s$

    s = "=1 L2"
    a = Array("Dell", "LGA 1*")

    If Not BV_Filter_GetParams_ByStr_OneLogic_OneCol(a, s, a, , 2, True, True) Then Exit Sub
    Worksheets.add After:=ActiveSheet
    [a1].Value2 = "'" & s
    [a4].Resize(UBound(a, 1), UBound(a, 2)).Value2 = a

    a = Array("Logic", "(", "ColNum", "CodeParam", "Value", ")")
    [A3].Resize(1, UBound(a)).Value2 = a
End Sub
'==================================================================================================
'==================================================================================================
'==================================================================================================
Function BV_Filter_Run(aFilt_In, aParam_In, aOutIn, Optional RetIndexes As Boolean, Optional Msg–1_Err As Boolean, Optional Msg0_Empty As Boolean, Optional Msg1_Full As Boolean) As Long
Dim rOld&, rNew&

    rOld = UBound(aFilt_In, 1) - LBound(aFilt_In, 1) + 1
    On Error Resume Next
    BV.ArrayFilterV aFilt_In, aParam_In, RetIndexes, aOutIn

    If (Err.Number <> 0) Then
        If Msg–1_Err Then MsgBox "UnCorrect condition(s)!", vbCritical, "BV_Filter_Run"
        Err.Clear: BV_Filter_Run = -1: Exit Function
    End If

    rNew = UBound(aOutIn, 1) - LBound(aOutIn, 1) + 1

    If (rNew < 1) Then
        If Msg0_Empty Then MsgBox "Can't Find any Row!", vbExclamation, "BV_Filter_Run"
        Exit Function
    End If

    BV_Filter_Run = 1
    If Msg1_Full Then MsgBox "Filter Rows: " & Format$(rNew, "#,#") & " out of " & Format$(rOld, "#,#"), vbInformation, "BV_Filter_Run"
End Function
'==================================================================================================

Option Base 1
Option Explicit
'Option Private Module
'==================================================================================================
Public WH_ReCalc As Boolean
'==================================================================================================
Function WorkHours(HourBeg&, HourEnd&, ByVal DT_Beg As Date, ByVal DT_End As Date) As Double
Dim rng As Range
Dim x, arr, f As Boolean
Dim hB#, hE#, fB&, fE&, h&, u&, n&, v&
Static st&, aHol() As Byte, HolMin&, HolMax&, fHol As Boolean

    If (st = 1) Then If WH_ReCalc Then st = 0: WH_ReCalc = False

    If (st = 0) Then
        st = 1
        HolMax = 0: HolMin = 1000000000: fHol = False

        On Error Resume Next
        Set rng = Range("WH_Holidays")  ' One Area
        On Error GoTo 0: If (rng Is Nothing) Then GoTo nx

        u = Fix(Now) + 1000: ReDim aHol(u)
        arr = rng.Value: If Not IsArray(arr) Then arr = Array(arr)

        For Each x In arr
            If (VarType(x) <> vbDate) Then GoTo nxX
            If (Val(x) = 0) Then GoTo nxX

            n = Fix(x): fHol = True
            If (n > HolMax) Then HolMax = n
            If (n < HolMin) Then HolMin = n
            
            If (n > u) Then u = 2 * n: ReDim Preserve aHol(u)
            aHol(n) = 1
nxX:    Next x
            
        If fHol Then ReDim Preserve aHol(HolMax)
    End If

nx:
If (DT_Beg > DT_End) Then hB = DT_Beg: DT_Beg = DT_End: DT_End = hB

fB = Fix(DT_Beg): fE = Fix(DT_End)
hB = 24 * (DT_Beg - fB): If (hB < HourBeg) Then hB = HourBeg
hE = 24 * (DT_End - fE): If (hE > HourEnd) Then hE = HourEnd
h = HourEnd - HourBeg: n = 0: v = 0

If fHol Then f = Not ((fB > HolMax) Or (fE < HolMin))

If f Then
    On Error Resume Next
        v = aHol(fB)

        If (fB = fE) Then   ' OneDay
            If (v = 1) Then Exit Function
            hB = hE - hB: hE = 0
        Else
            If (v = 1) Then
                v = 0: hB = 0
            Else
                hB = HourEnd - hB: If (hB < 0) Then hB = 0
            End If
            
            v = aHol(fE)

            If (v = 1) Then
                v = 0: hE = 0
            Else
                hE = hE - HourBeg: If (hE < 0) Then hE = 0
            End If
        End If

        For u = fB + 1 To fE - 1
            v = aHol(u)
            If (v = 1) Then v = 0 Else n = n + 1
        Next u

    On Error GoTo 0
Else
    hB = HourEnd - hB: If (hB < 0) Then hB = 0
    hE = hE - HourBeg: If (hE < 0) Then hE = 0
    n = fE - fB - 1
End If

WorkHours = h * n + hB + hE
End Function
'==================================================================================================
Private Sub Test_WorkHours()
    Debug.Print WorkHours([b1], [b2], [a13], [b13])
End Sub
'==================================================================================================

Option Base 1
Option Explicit
'Option Private Module
'==================================================================================================
Private Sub Worksheet_Deactivate()
    WH_ReCalc = True
    Application.CalculateFullRebuild
End Sub
'==================================================================================================

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Public BV As New BedvitCOM.VBA
'==================================================================================================
Enum e_BV_Filt_Logic
    Or_ = 0
    And_ = 1
End Enum
'==================================================================================================
Enum e_BV_Filt_Oper
    Less = 1
    Equal = 2
    More = 4
    InStr_ = 8
    RegExp = 16
    CaseIgnore = 32
    Basic = 64
    Extended = 128
    Like_ = 256
    Not_ = 512
End Enum
'==================================================================================================
'==================================================================================================
'==================================================================================================
Function BV_Filter_GetParams(aPar_Out, aColOperVal, Optional UseOR As Boolean, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim n&, r&, logic&

If Not IsArray(aColOperVal) Then
    If MsgFalse Then MsgBox "Argument «aColOperVal» is NOT Array!", vbCritical, "BV_Filter_GetParams"
    Exit Function
End If

BV.ArrayReDim aColOperVal, 1    ' Set LBound to 1
n = UBound(aColOperVal)         ' Count of Elements

If ((n Mod 3) <> 0) Then
    If MsgFalse Then MsgBox "«aColOperVal» is NOT Divisible by 3!", vbCritical, "BV_Filter_GetParams"
    Exit Function
End If

If Not UseOR Then logic = 1     ' 0 is Or, 1 is And (As Default)
ReDim aPar_Out(n / 3, 6)

For n = 1 To n Step 3
    r = r + 1
    aPar_Out(r, 1) = logic
    aPar_Out(r, 2) = "("
    aPar_Out(r, 3) = aColOperVal(n)
    aPar_Out(r, 4) = aColOperVal(n + 1) ' e_BV_FiltParam
    aPar_Out(r, 5) = aColOperVal(n + 2) ' Value
    aPar_Out(r, 6) = ")"
Next n

If MsgTrue Then MsgBox "2D-Array (Rows: " & Format$(r, "#,#") & ") with Parameters for BV.ArrayFilterV was successfully created!", vbInformation, "BV_Filter_GetParams"
BV_Filter_GetParams = True
End Function
'==================================================================================================
Function BV_Filter_GetParams_OneCol(aPar_Out, aOperVal, Optional nCol& = 1, Optional UseOR As Boolean, Optional MsgTrue As Boolean, Optional MsgFalse As Boolean) As Boolean
Dim n&, r&, logic&

If Not IsArray(aOperVal) Then
    If MsgFalse Then MsgBox "Argument «aOperVal» is NOT Array!", vbCritical, "BV_Filter_GetParams_OneCol"
    Exit Function
End If

BV.ArrayReDim aOperVal, 1    ' Set LBound to 1
n = UBound(aOperVal)         ' Count of Elements

If ((n Mod 2) <> 0) Then
    If MsgFalse Then MsgBox "«aOperVal» is NOT Divisible by 2!", vbCritical, "BV_Filter_GetParams_OneCol"
    Exit Function
End If

If Not UseOR Then logic = 1     ' 0 is Or, 1 is And (As Default)
ReDim aPar_Out(n / 2, 6)

For n = 1 To n Step 2
    r = r + 1
    aPar_Out(r, 1) = logic
    aPar_Out(r, 2) = "("
    aPar_Out(r, 3) = nCol
    aPar_Out(r, 4) = aOperVal(n)        ' e_BV_FiltParam
    aPar_Out(r, 5) = aOperVal(n + 1)    ' Value
    aPar_Out(r, 6) = ")"
Next n

If MsgTrue Then MsgBox "2D-Array (Rows: " & Format$(r, "#,#") & ") with Parameters for BV.ArrayFilterV was successfully created!", vbInformation, "BV_Filter_GetParams_OneCol"
BV_Filter_GetParams_OneCol = True
End Function
'==================================================================================================
'==================================================================================================
'==================================================================================================
Function BV_Filter_Run(aFilt_In, aParam_In, aOutIn, Optional RetIndexes As Boolean, Optional Msg–1_Err As Boolean, Optional Msg0_Empty As Boolean, Optional Msg1_Full As Boolean) As Long
Dim rOld&, rNew&

    rOld = UBound(aFilt_In, 1) - LBound(aFilt_In, 1) + 1
    On Error Resume Next
    BV.ArrayFilterV aFilt_In, aParam_In, RetIndexes, aOutIn

    If (Err.Number <> 0) Then
        If Msg–1_Err Then MsgBox "UnCorrect condition(s)!", vbCritical, "BV_Filter_Run"
        Err.Clear: BV_Filter_Run = -1: Exit Function
    End If

    rNew = UBound(aOutIn, 1) - LBound(aOutIn, 1) + 1

    If (rNew < 1) Then
        If Msg0_Empty Then MsgBox "Can't Find any Row!", vbExclamation, "BV_Filter_Run"
        Exit Function
    End If

BV_Filter_Run = 1
If Msg1_Full Then MsgBox "Filter Rows: " & Format$(rNew, "#,#") & " out of " & Format$(rOld, "#,#"), vbInformation, "BV_Filter_Run"
End Function
'==================================================================================================
'==================================================================================================
'==================================================================================================
'==================================================================================================
'==================================================================================================

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Private Sub ManualParams(aParOut)
                        '          1              2                          3                   4
    ReDim aParOut(4, 6) ' Rule: ( (Col2 = "Dell") And (Col4 Like "LGA 1*") ) Or ( (Col2 = "HPE") And (Col5 Not Like "2*") )

    aParOut(1, 1) = "ANYTHING" ' 1st Logic will be cleared automatic in library(COM)
    aParOut(1, 2) = "(("
    aParOut(1, 3) = 2
    aParOut(1, 4) = e_BV_Filt_Oper.Equal
    aParOut(1, 5) = "Dell"
    aParOut(1, 6) = ")"

    aParOut(2, 1) = e_BV_Filt_Logic.And_
    aParOut(2, 2) = "("
    aParOut(2, 3) = 4
    aParOut(2, 4) = e_BV_Filt_Oper.Like_
    aParOut(2, 5) = "LGA 1*"
    aParOut(2, 6) = "))"
    
    
    aParOut(3, 1) = e_BV_Filt_Logic.Or_
    aParOut(3, 2) = "(("
    aParOut(3, 3) = 2
    aParOut(3, 4) = e_BV_Filt_Oper.Equal
    aParOut(3, 5) = "HPE"
    aParOut(3, 6) = ")"
    
    aParOut(4, 1) = e_BV_Filt_Logic.And_
    aParOut(4, 2) = "("
    aParOut(4, 3) = 5
    aParOut(4, 4) = e_BV_Filt_Oper.Like_ + e_BV_Filt_Oper.Not_
    aParOut(4, 5) = "2*"
    aParOut(4, 6) = "))"
End Sub
'==================================================================================================
Sub TestFilter()
Dim x, aT, aP, aL, t!

aT = ActiveSheet.ListObjects(1).DataBodyRange.Value2

t = Timer
    ' Choose ONE(out of 6) Variant --------------
    aP = Array(5, e_BV_Filt_Oper.Equal + e_BV_Filt_Oper.Not_, "1U rack")        ' 1. Col5 is NOT Equal "1U rack" (Col5 is Equal "2U rack" because there are only 2 Values in Col5)

    x = Array(e_BV_Filt_Oper.InStr_, "e", e_BV_Filt_Oper.InStr_, "n")
    If Not BV_Filter_GetParams_OneCol(aP, x, 2, False, , True) Then Exit Sub    ' 2. Col2 have "e" AND Col2 have "n". Intel,Lenovo.

    x = Array(e_BV_Filt_Oper.InStr_ + e_BV_Filt_Oper.CaseIgnore, "d", e_BV_Filt_Oper.InStr_ + e_BV_Filt_Oper.CaseIgnore, "i")
    If Not BV_Filter_GetParams_OneCol(aP, x, 2, True, , True) Then Exit Sub     ' 3. Col2 have "d/D" OR Col2 have "i/I"(CaseIgnore). Dell,Intel.

    x = Array(2, e_BV_Filt_Oper.Equal, "Dell", 4, e_BV_Filt_Oper.Like_, "LGA ####")
    If Not BV_Filter_GetParams(aP, x, False, , True) Then Exit Sub              ' 4. Col2 = "Dell" AND Col4 Like "LGA ####".

    x = Array(2, e_BV_Filt_Oper.Equal, "HPE", 4, e_BV_Filt_Oper.Like_, "LGA 1*")
    If Not BV_Filter_GetParams(aP, x, True, , True) Then Exit Sub               ' 5. Col2 = "HPE" OR Col4 Like "LGA 1*".

    ManualParams aP                                                             ' 6. Manual Params

    ' Filter ------------------------------------
    If (BV_Filter_Run(aT, aP, aL, , True, True) <> 1) Then Exit Sub             ' Include Msgs if not Full
t = Timer - t

' Load on Sheet ---------------------------------
[N2:R200].ClearContents
[N2].Resize(UBound(aL, 1), UBound(aL, 2)).Value2 = aL

MsgBox "Load Rows: " & Format$(UBound(aL, 1), "#,#") & " out of " & Format$(UBound(aT, 1), "#,#"), vbInformation, "FilterTime: " & Format$(t, "0.0 sec.")
End Sub
'==================================================================================================

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Private Sub Test()
Dim aK$(), aV$()
Dim a, b, t!
Const sep = ", "

' Prepare ---------------------------------------
t = Timer                                           ' UnSort. Count of Repeats:
    CreateArr2Col a, 100000, 100, True              ' 0   | 10  | 100
Debug.Print Round(Timer - t, 2), "CreateArr"        ' 0.1 | 0.6 | 6.0

' Variants --------------------------------------

b = a: t = Timer
    Sort_Join_BV b, sep, aK, aV
Debug.Print Round(Timer - t, 2), "Sort_Join_BV"     ' 0.1 | 0.6 | 7.0
'Debug.Print aK(100), "«" & aV(100) & "»"


b = a: t = Timer
    Sort_Mid_BV b, sep, aK, aV
Debug.Print Round(Timer - t, 2), "Sort_Mid_BV"      ' 0.1 | 0.6 | 6.8
'Debug.Print aK(100), "«" & aV(100) & "»"


't = Timer
'    Progressive_BV a, sep, aK, aV
'Debug.Print Round(Timer - t, 2), "Progressive_BV"  ' 0.1 | 1.2 | 13.3
''Debug.Print aK(100), "«" & aV(100) & "»"


' Out of Compare --------------------------------
't = Timer
'    Progressive a, sep, aK, aV
'Debug.Print Round(Timer - t, 2), "Progressive"     ' 31.2 for 100 Repeats(UnSort)
''Debug.Print aK(100), "«" & aV(100) & "»"
'
'
't = Timer
'    Middle a, sep, aK, aV
'Debug.Print Round(Timer - t, 2), "Middle"          ' 28.0 for 100 Repeats(UnSort)
''Debug.Print aK(100), "«" & aV(100) & "»"

End Sub
'==================================================================================================
'==================================================================================================
'==================================================================================================

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Public BV As New BedvitCOM.VBA
'==================================================================================================
'==================================================================================================
'==================================================================================================
Sub Progressive_BV(a2Col_In, sSep_In$, aKeys_Out() As String, aJoin_Out() As String)
Dim map As New BedvitCOM.UnorderedMap
Dim x, s$, r&, n&

r = UBound(a2Col_In, 1)
ReDim aKeys_Out(r), aJoin_Out(r)

For r = 1 To r
    s = a2Col_In(r, 1)

    If (map.Find(s, x)) Then
        aJoin_Out(x) = aJoin_Out(x) & sSep_In & a2Col_In(r, 2)
    Else
        n = n + 1: map.Insert s, n
        aKeys_Out(n) = s
        aJoin_Out(n) = a2Col_In(r, 2)
    End If
Next r

ReDim Preserve aKeys_Out(n), aJoin_Out(n)
End Sub
'==================================================================================================
'==================================================================================================
Sub Sort_Join_BV(a2Col_In, sSep_In$, aKeys_Out() As String, aJoin_Out() As String)
Dim a, aJ$(), sOld$, sNew$, t!, r&, n&, j&, UBnd&
Const UBcnst& = 100

't = Timer
    BV.ArraySortV a2Col_In
'Debug.Print Round(Timer - t, 2), "Sort_Join_BV(Sort)"   ' ~ 50% of TotalTime

r = UBound(a2Col_In, 1): UBnd = UBcnst
ReDim aKeys_Out(r), aJoin_Out(r), aJ(UBnd)

't = Timer
    sOld = a2Col_In(1, 1)
    j = 1: aJ(j) = a2Col_In(1, 2)

    For r = 2 To r
        sNew = a2Col_In(r, 1)
        
        If (sOld = sNew) Then
            If (j = UBnd) Then UBnd = 10 * UBnd: ReDim Preserve aJ(UBnd)
            j = j + 1: aJ(j) = a2Col_In(r, 2)
        Else
            n = n + 1
            aKeys_Out(n) = sOld: sOld = sNew
            ReDim Preserve aJ(j): aJoin_Out(n) = Join(aJ, sSep_In)
            If (UBnd <> UBcnst) Then UBnd = UBcnst: ReDim aJ(UBnd)
            j = 1: aJ(j) = a2Col_In(r, 2)
        End If
    Next r

    n = n + 1
    aKeys_Out(n) = sOld
    ReDim Preserve aJ(j): aJoin_Out(n) = Join(aJ, sSep_In)
'Debug.Print Round(Timer - t, 2), "Sort_Join_BV(Main)"   ' ~ 50% of TotalTime

ReDim Preserve aKeys_Out(n), aJoin_Out(n)
End Sub
'==================================================================================================
'==================================================================================================
Sub Sort_Mid_BV(a2Col_In, sSep_In$, aKeys_Out() As String, aJoin_Out() As String)
Dim sBuf$, sW$, sOld$, sNew$, t!, r&, n&, lS&, lW&, lP&, ll&
Const lB& = 32767

't = Timer
    BV.ArraySortV a2Col_In
'Debug.Print Round(Timer - t, 2), "Sort_Mid(Sort)"   ' ~ 40% of TotalTime

r = UBound(a2Col_In, 1)
ReDim aKeys_Out(r), aJoin_Out(r)

lS = Len(sSep_In)
sBuf = Space$(lB)

't = Timer
    sOld = a2Col_In(1, 1)
    sW = a2Col_In(1, 2): lW = Len(sW)
    Mid$(sBuf, 1, lW) = sW: lP = lW

    For r = 2 To r
        sNew = a2Col_In(r, 1)

        If (sOld = sNew) Then
            sW = a2Col_In(r, 2): lW = Len(sW)
            ll = lP + lS + lW: If (ll > lB) Then Stop: End

            Mid$(sBuf, lP + 1, lS) = sSep_In
            Mid$(sBuf, lP + 1 + lS, lW) = sW
            lP = ll
        Else
            n = n + 1
            aKeys_Out(n) = sOld: sOld = sNew
            aJoin_Out(n) = Left$(sBuf, lP)
            
            sW = a2Col_In(r, 2): lW = Len(sW)
            Mid$(sBuf, 1, lW) = sW: lP = lW
        End If
    Next r

    n = n + 1
    aKeys_Out(n) = sOld
    aJoin_Out(n) = Left$(sBuf, lP)

'Debug.Print Round(Timer - t, 2), "Sort_Mid(Main)"   ' ~ 60% of TotalTime

ReDim Preserve aKeys_Out(n), aJoin_Out(n)
End Sub
'==================================================================================================
'==================================================================================================
'==================================================================================================
Sub CreateArr2Col(aOut, nUniq&, nRepeats&, Optional UnSort As Boolean)
Dim n&, r&, p&

If UnSort Then
    ReDim aOut(nUniq * (1 + nRepeats), 3)   ' Key, Value, Sort(Optional Temp)
Else
    ReDim aOut(nUniq * (1 + nRepeats), 2)
End If

For n = 1 To nUniq
    r = r + 1
    aOut(r, 1) = "Key_" & n
    aOut(r, 2) = "Val_" & r
    If UnSort Then aOut(r, 3) = Rnd()
    
    For p = 1 To nRepeats
        r = r + 1
        aOut(r, 1) = aOut(r - 1, 1)
        aOut(r, 2) = "Val_" & r
        If UnSort Then aOut(r, 3) = Rnd()
    Next p
Next n

If Not UnSort Then Exit Sub

BV.ArraySortV aOut, 3
ReDim Preserve aOut(UBound(aOut), 2)

End Sub
'==================================================================================================
'==================================================================================================
'==================================================================================================

Option Base 1
Option Explicit
Option Private Module
'==================================================================================================
Sub Progressive(a2Col_In, sSep_In$, aKeys_Out() As String, aJoin_Out() As String)
Dim dic As New Dictionary
Dim s$, r&, n&, p&

r = UBound(a2Col_In, 1)
ReDim aKeys_Out(r), aJoin_Out(r)

For r = 1 To r
    s = a2Col_In(r, 1)
    p = dic(s)
    
    If (p = 0) Then
        n = n + 1: dic(s) = n
        aKeys_Out(n) = s
        aJoin_Out(n) = a2Col_In(r, 2)
    Else
        aJoin_Out(p) = aJoin_Out(p) & sSep_In & a2Col_In(r, 2)
    End If
Next r

ReDim Preserve aKeys_Out(n), aJoin_Out(n)
End Sub
'==================================================================================================
Sub Middle(a2Col_In, sSep_In$, aKeys_Out() As String, aJoin_Out() As String)
Dim dic As New Dictionary
Dim aPos&()
Dim s$, sps$, t!, r&, n&, p&, l&, lSep&, lPos&, ll&
Const lBuf& = 1000

sps = Space$(lBuf): lSep = Len(sSep_In): r = UBound(a2Col_In, 1)
ReDim aKeys_Out(r), aJoin_Out(r), aPos(r)

't = Timer
    For r = 1 To r
        s = a2Col_In(r, 1)
        p = dic(s)
        
        If (p = 0) Then
            n = n + 1: dic(s) = n
            aKeys_Out(n) = s
            
            s = a2Col_In(r, 2): l = Len(s)
            aJoin_Out(n) = sps
            Mid$(aJoin_Out(n), 1, l) = s
            
            aPos(n) = l
        Else
            s = a2Col_In(r, 2): l = Len(s)
            lPos = aPos(p):     ll = lPos + lSep + l
            
            If (ll > lBuf) Then
                aJoin_Out(p) = Left$(aJoin_Out(p), aPos(p)) & sSep_In & s
            Else
                Mid$(aJoin_Out(p), lPos + 1, lSep) = sSep_In
                Mid$(aJoin_Out(p), lPos + 1 + lSep, l) = s
            End If

            aPos(p) = ll
        End If
    Next r
'Debug.Print Round(Timer - t, 2), "Middle(Main)"

ReDim Preserve aKeys_Out(n), aJoin_Out(n)

't = Timer
    For n = 1 To n
        aJoin_Out(n) = Left$(aJoin_Out(n), aPos(n))
    Next n
'Debug.Print Round(Timer - t, 2), "Middle(Cut)"
End Sub
'==================================================================================================
'==================================================================================================