Find, Max function

[vmjan02]

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

		Sunday	Monday	Tuesday	Wednesday	Thursday	Friday	Saturday
ID	Name	7/11/21	7/12/21	7/13/21	7/14/21	7/15/21	7/16/21	7/17/21	No of Shift (Output)	Week Off (Output)
1​	a	OFF	1500-2100	1500-2100	1500-2100	1500-2100	1500-2100	1200-2100	1500-2100	Sun
2​	b	OFF	OFF	OFF	OFF	OFF	OFF	OFF	-	sun,Mon,tue,Wed,thu,fri,Sat
3​	c	OFF	0800-1830	0800-1830	0800-1830	0800-1830	OFF	OFF	0800-1830	Sun,Fir,Sat
4​	d	0700-1530	0700-1530	OFF	OFF	0700-1530	0700-1530	0700-1530	0700-1530	Tue,Wed
5​	e	0700-1100	1030-1430	OFF	OFF	OFF	1030-1430	0700-1100	0700-1100 : 1030-1430	Tue,Wed,thu
6​	f	OFF	0900-1700	0900-1700	0900-1700	0900-1700	0900-1700	OFF	0900-1700	Sun, Sat
7​	g	1630-0100	OFF	OFF	1630-0100	1630-0100	No longer employed	1630-0100	1630-0100	Mon, Tue
8​	h	1000-1830	1000-1830	1000-1830	OFF	OFF	1000-1830	Suspended	1000-1830	Wed,thu
13​	m	OFF	Leave of absence	Leave of absence	Leave of absence	Leave of absence	Leave of absence	OFF	-	Sun, Sat

 

[Crystalyzer]

Here is the update

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, 1)) Then
            arr.Add a, a
        End If
    Next
    On Error GoTo 0

    Select Case arr.Count
    Case Is = 1
        MaxShifts = arr(1) 'Mid(arr(1), 1, 2) & ":" & Mid(arr(1), 3, 2) & " - " & Mid(arr(1), 6, 2) & ":" & 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 = d(0, j)  'Mid(d(0, j), 1, 2) & ":" & Mid(d(0, j), 3, 2) & " - " & Mid(d(0, j), 6, 2) & ":" & Mid(d(0, j), 8, 2) '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 = d(0, j) & " : " & d(0, j) 'MaxShifts & " : " & Mid(d(0, j), 1, 2) & ":" & Mid(d(0, j), 3, 2) & " - " & Mid(d(0, j), 6, 2) & ":" & Mid(d(0, j), 8, 2) ' 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

 

[vmjan02]

I am getting all link this
MaxShifts and is perfect need not to change it, we will need a new function to change the column wise time to 9:00 - 17:50

Sunday

7/11/21

#NAME?​

#NAME?​

#NAME?​

#NAME?​

#NAME?​

#NAME?​

#NAME?​

#NAME?​

#NAME?​

#NAME?​

#NAME?​

#NAME?​

 

[Crystalyzer]

Did you remove the previous code?