Find, Max function

vmjan02

Well-known Member
Joined
Aug 15, 2012
Messages
1,132
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
  5. 2013
I have this roster and need to find
1.The max time shift for every emp in No of shift column
2.Need to display the week day off in Week off column
by any change is there a function or VBA code to find the same. below is the sample

SundayMondayTuesdayWednesdayThursdayFridaySaturday
IDName7/11/217/12/217/13/217/14/217/15/217/16/217/17/21No of Shift (Output)Week Off (Output)
1​
aOFF1500-21001500-21001500-21001500-21001500-21001200-21001500-2100Sun
2​
bOFFOFFOFFOFFOFFOFFOFF-sun,Mon,tue,Wed,thu,fri,Sat
3​
cOFF0800-18300800-18300800-18300800-1830OFFOFF0800-1830Sun,Fir,Sat
4​
d0700-15300700-1530OFFOFF0700-15300700-15300700-15300700-1530Tue,Wed
5​
e0700-11001030-1430OFFOFFOFF1030-14300700-11000700-1100 : 1030-1430Tue,Wed,thu
6​
fOFF0900-17000900-17000900-17000900-17000900-1700OFF0900-1700Sun, Sat
7​
g1630-0100OFFOFF1630-01001630-0100No longer employed1630-01001630-0100Mon, Tue
8​
h1000-18301000-18301000-1830OFFOFF1000-1830Suspended1000-1830Wed,thu
13​
mOFFLeave of absenceLeave of absenceLeave of absenceLeave of absenceLeave of absenceOFF-Sun, Sat
 
test1.xlsx
ABCDEFGHIJK
1SundayMondayTuesdayWednesdayThursdayFridaySaturday
2IDName7/11/20217/12/20217/13/20217/14/20217/15/20217/16/20217/17/2021No of Shift (Output)Week Off (Output)
31a1200-21001500-21001500-21001500-21001500-21001500-21001200-21001500-2100 
42bOFFOFFOFFOFFOFFOFFOFF Sun, Mon, Tue, Wed, Thu, Fri, Sat
53cOFF0800-18300800-18300800-18300800-1830OFFOFF0800-1830Sun, Fri, Sat
64d0700-15300700-1530OFFOFF0700-15300700-15300700-15300700-1530Tue, Wed
75e0700-11001030-1430OFFOFFOFF0700-11001030-14300700-1100 : 1030-1430Tue, Wed, Thu
86fOFF0900-17000900-17000900-17000900-17000900-1700OFF0900-1700Sun, Sat
97g1630-0100OFFOFF1630-01001630-0100No longer employed1630-01001630-0100Mon, Tue
108h1000-18301000-18301000-1830OFFOFF1000-1830Suspended1000-1830Wed, Thu
1113mOFFLeave of absenceLeave of absenceLeave of absenceLeave of absenceLeave of absenceOFF Sun, Sat
Sheet5
Cell Formulas
RangeFormula
J3:J11J3=MaxShifts(C3:I3)
K3:K11K3=DaysOff($C$1:$I$1,C3:I3)
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
test1.xlsx
ABCDEFGHIJK
1SundayMondayTuesdayWednesdayThursdayFridaySaturday
2IDName7/11/20217/12/20217/13/20217/14/20217/15/20217/16/20217/17/2021No of Shift (Output)Week Off (Output)
31a1200-21001500-21001500-21001500-21001500-21001500-21001200-21001500-2100 
42bOFFOFFOFFOFFOFFOFFOFF Sun, Mon, Tue, Wed, Thu, Fri, Sat
53cOFF0800-18300800-18300800-18300800-1830OFFOFF0800-1830Sun, Fri, Sat
64d0700-15300700-1530OFFOFF0700-15300700-15300700-15300700-1530Tue, Wed
75e0700-11001030-1430OFFOFFOFF0700-11001030-14300700-1100 : 1030-1430Tue, Wed, Thu
86fOFF0900-17000900-17000900-17000900-17000900-1700OFF0900-1700Sun, Sat
97g1630-0100OFFOFF1630-01001630-0100No longer employed1630-01001630-0100Mon, Tue
108h1000-18301000-18301000-1830OFFOFF1000-1830Suspended1000-1830Wed, Thu
1113mOFFLeave of absenceLeave of absenceLeave of absenceLeave of absenceLeave of absenceOFF Sun, Sat
Sheet5
Cell Formulas
RangeFormula
J3:J11J3=MaxShifts(C3:I3)
K3:K11K3=DaysOff($C$1:$I$1,C3:I3)
=MaxShifts(C3:I3)
it is so perfcet,

this is the out I am getting. can this be fixed.

SundayMondayTuesdayWednesdayThursdayFridaySaturday
7/11/217/12/217/13/217/14/217/15/217/16/217/17/21No of shifts
1​
aOFFOFFABS - COVID19ABS - COVID19ABS - COVID19OFFABS - COVID19ABS - COVID19this needs to be blank
2​
bSuspendedSuspendedOFFOFFOFF0900-22000900-2200Suspended : 0900-2200Only time
3​
cOFFABS - COVID19ABS - COVID19OFFABS - COVID190930-18000930-1800ABS - COVID19this needs to be blank
4​
dSuspendedSuspendedOFFOFFOFF1100-21301100-2130Suspended : 1100-2130Only time
5​
eABS - COVID19OFFOFFABS - COVID19ABS - COVID19ABS - COVID19ABS - COVID19ABS - COVID19this needs to be blank
6​
fOFFOFFABS - COVID19ABS - COVID19ABS - COVID190930-18000930-1800ABS - COVID19this needs to be blank
7​
gLeave of absenceLeave of absenceOFFOFFOFF0900-19300900-1930Leave of absence : 0900-1930Only time
 
Upvote 0
the fix is the code snippet below basically replace "If a <> "OFF" Then" with "If IsNumeric(Mid(a, 1, 4)) Then"

VBA Code:
  On Error Resume Next
    For Each a In s
        If IsNumeric(Mid(a, 1, 4)) Then
        'If a <> "OFF" Then
            arr.Add a, a
        End If
    Next
    On Error GoTo 0
 
Upvote 0
you're welcome. Please mark my post as the solution! Have a great day!
 
Upvote 0
@Crystalyzer

Can we get the output for the function as 15:00 - 21:00.
currently output is 1500-2100 (this is all perfect)

but can it be modified as hh:mm - hh:mm


=MaxShifts(C3:I3)
 
Upvote 0
Here ya go

VBA Code:
Function MaxShifts(sel As Range) As String
    Dim arr As New Collection
    Dim a As Variant, s As Variant, d As Variant
    Dim i As Integer
    Dim j As Integer
    Dim tmpMax As Long

    If sel.Rows.Count <> 1 Then
        MaxShifts = "#ERROR! Select only 1 row of data."
        Exit Function
    End If

    s = sel.Value

    On Error Resume Next
    For Each a In s
        If IsNumeric(Mid(a, 1, 4)) Then
            'a = Mid(a, 1, 2) & ":" & Mid(a, 3, 5) & ":" & Mid(a, 8, 2)
            arr.Add a, a
        End If
    Next
    On Error GoTo 0

    Select Case arr.Count
    Case Is = 1
        MaxShifts = Mid(arr(1), 1, 2) & ":" & Mid(arr(1), 3, 5) & ":" & Mid(arr(1), 8, 2)
    Case Is > 1
        ReDim d(1, arr.Count - 1)
        For i = 0 To arr.Count - 1
            d(0, i) = arr(i + 1)
            d(1, i) = WorksheetFunction.CountIf(sel, "=" & arr(i + 1))
        Next i

        For j = LBound(d, 1) To UBound(d, 1)
            If d(1, j) > tmpMax Then tmpMax = d(1, j)
        Next j

        For j = LBound(d, 1) To UBound(d, 1)
            If MaxShifts = "" Then
                If d(1, j) = tmpMax Then MaxShifts = Mid(d(0, j), 1, 2) & ":" & Mid(d(0, j), 3, 5) & ":" & Mid(d(0, j), 8, 2)
            Else
                If d(1, j) = tmpMax Then MaxShifts = MaxShifts & " : " & Mid(d(0, j), 1, 2) & ":" & Mid(d(0, j), 3, 5) & ":" & Mid(d(0, j), 8, 2)
            End If
        Next j
    Case Else
        MaxShifts = ""
    End Select

    If InStr(1, MaxShifts, "-", vbTextCompare) = 0 Then MaxShifts = ""

End Function
 
Upvote 0
Here ya go

VBA Code:
Function MaxShifts(sel As Range) As String
    Dim arr As New Collection
    Dim a As Variant, s As Variant, d As Variant
    Dim i As Integer
    Dim j As Integer
    Dim tmpMax As Long

    If sel.Rows.Count <> 1 Then
        MaxShifts = "#ERROR! Select only 1 row of data."
        Exit Function
    End If

    s = sel.Value

    On Error Resume Next
    For Each a In s
        If IsNumeric(Mid(a, 1, 4)) Then
            'a = Mid(a, 1, 2) & ":" & Mid(a, 3, 5) & ":" & Mid(a, 8, 2)
            arr.Add a, a
        End If
    Next
    On Error GoTo 0

    Select Case arr.Count
    Case Is = 1
        MaxShifts = Mid(arr(1), 1, 2) & ":" & Mid(arr(1), 3, 5) & ":" & Mid(arr(1), 8, 2)
    Case Is > 1
        ReDim d(1, arr.Count - 1)
        For i = 0 To arr.Count - 1
            d(0, i) = arr(i + 1)
            d(1, i) = WorksheetFunction.CountIf(sel, "=" & arr(i + 1))
        Next i

        For j = LBound(d, 1) To UBound(d, 1)
            If d(1, j) > tmpMax Then tmpMax = d(1, j)
        Next j

        For j = LBound(d, 1) To UBound(d, 1)
            If MaxShifts = "" Then
                If d(1, j) = tmpMax Then MaxShifts = Mid(d(0, j), 1, 2) & ":" & Mid(d(0, j), 3, 5) & ":" & Mid(d(0, j), 8, 2)
            Else
                If d(1, j) = tmpMax Then MaxShifts = MaxShifts & " : " & Mid(d(0, j), 1, 2) & ":" & Mid(d(0, j), 3, 5) & ":" & Mid(d(0, j), 8, 2)
            End If
        Next j
    Case Else
        MaxShifts = ""
    End Select

    If InStr(1, MaxShifts, "-", vbTextCompare) = 0 Then MaxShifts = ""

End Function
kool, all good thanks man all perfect,

can we get the output as 15:00 - 21:00 inst of 15:00-21:00
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,259
Members
452,626
Latest member
huntinghunter

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
Back
Top