Find, Max function

V

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
 
Sort by date Sort by votes
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
            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, 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 = Mid(arr(1), 1, 2) & ":" & Mid(arr(1), 3, 2) & " - " & Mid(arr(1), 6, 2) & ":" & Mid(arr(1), 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 = MaxShifts & " : " & Mid(arr(1), 1, 2) & ":" & Mid(arr(1), 3, 2) & " - " & Mid(arr(1), 6, 2) & ":" & Mid(arr(1), 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
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
per
Crystalyzer said:
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
            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, 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 = Mid(arr(1), 1, 2) & ":" & Mid(arr(1), 3, 2) & " - " & Mid(arr(1), 6, 2) & ":" & Mid(arr(1), 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 = MaxShifts & " : " & Mid(arr(1), 1, 2) & ":" & Mid(arr(1), 3, 2) & " - " & Mid(arr(1), 6, 2) & ":" & Mid(arr(1), 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
Click to expand...
Perfect. yes will change the solution.
A lot of thinks are going on, and that too on single desk. :)
 
Upvote 0
@Crystalyzer

Can you check as earlier it was showing perfect as 07:00-11:00 : 10:30-14:30
but now it is not catching it rightly not showing 2 diff times. thanks only in these cases, rest it is perfect.

SundayMondayTuesdayWednesdayThursdayFridaySaturday
7/11/217/12/217/13/217/14/217/15/217/16/217/17/21No of shifts
0700-11001030-1430OFFOFFOFF1030-14300700-110007:00 - 11:00 : 07:00 - 11:00
0615-14450600-14300630-1500OFFOFF0700-15300645-151506:15 - 14:45 : 06:15 - 14:45
 
Upvote 0
Sorry my mistake. I have corrected it below. Also here is the worksheet with your original data and the results including the two that you mentioned above.

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
            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, 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 = 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 = 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

Solutions 20210713.xlsm
ABCDEFGHIJK
1SundayMondayTuesdayWednesdayThursdayFridaySaturday
2IDName7/11/20217/12/20217/13/20217/14/20217/15/20217/16/20217/17/2021No of Shift (Output)Week Off (Output)
31aOFF1500-21001500-21001500-21001500-21001500-21001200-210015:00 - 21:00Sun
42bOFFOFFOFFOFFOFFOFFOFF Sun, Mon, Tue, Wed, Thu, Fri, Sat
53cOFF0800-18300800-18300800-18300800-1830OFFOFF08:00 - 18:30Sun, Fri, Sat
64d0700-15300700-1530OFFOFF0700-15300700-15300700-153007:00 - 15:30Tue, Wed
75e0700-11001030-1430OFFOFFOFF1030-14300700-110007:00 - 11:00 : 10:30 - 14:30Tue, Wed, Thu
86fOFF0900-17000900-17000900-17000900-17000900-1700OFF09:00 - 17:00Sun, Sat
97g1630-0100OFFOFF1630-01001630-0100No longer employed1630-010016:30 - 01:00Mon, Tue
108h1000-18301000-18301000-1830OFFOFF1000-1830Suspended10:00 - 18:30Wed, Thu
1113mOFFLeave of absenceLeave of absenceLeave of absenceLeave of absenceLeave of absenceOFF Sun, Sat
1213m0615-14450600-14300630-1500OFFOFF0700-15300645-151506:15 - 14:45 : 06:00 - 14:30Wed, Thu
1313m0700-11001030-1430OFFOFFOFF1030-14300700-110007:00 - 11:00 : 10:30 - 14:30Tue, Wed, Thu
Sheet5
Cell Formulas
RangeFormula
J3:J13J3=MaxShifts(C3:I3)
K3:K13K3=DaysOff($C$1:$I$1,C3:I3)
 
Upvote 0
Solution
Crystalyzer said:
Sorry my mistake. I have corrected it below. Also here is the worksheet with your original data and the results including the two that you mentioned above.

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
            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, 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 = 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 = 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

Solutions 20210713.xlsm
ABCDEFGHIJK
1SundayMondayTuesdayWednesdayThursdayFridaySaturday
2IDName7/11/20217/12/20217/13/20217/14/20217/15/20217/16/20217/17/2021No of Shift (Output)Week Off (Output)
31aOFF1500-21001500-21001500-21001500-21001500-21001200-210015:00 - 21:00Sun
42bOFFOFFOFFOFFOFFOFFOFF Sun, Mon, Tue, Wed, Thu, Fri, Sat
53cOFF0800-18300800-18300800-18300800-1830OFFOFF08:00 - 18:30Sun, Fri, Sat
64d0700-15300700-1530OFFOFF0700-15300700-15300700-153007:00 - 15:30Tue, Wed
75e0700-11001030-1430OFFOFFOFF1030-14300700-110007:00 - 11:00 : 10:30 - 14:30Tue, Wed, Thu
86fOFF0900-17000900-17000900-17000900-17000900-1700OFF09:00 - 17:00Sun, Sat
97g1630-0100OFFOFF1630-01001630-0100No longer employed1630-010016:30 - 01:00Mon, Tue
108h1000-18301000-18301000-1830OFFOFF1000-1830Suspended10:00 - 18:30Wed, Thu
1113mOFFLeave of absenceLeave of absenceLeave of absenceLeave of absenceLeave of absenceOFF Sun, Sat
1213m0615-14450600-14300630-1500OFFOFF0700-15300645-151506:15 - 14:45 : 06:00 - 14:30Wed, Thu
1313m0700-11001030-1430OFFOFFOFF1030-14300700-110007:00 - 11:00 : 10:30 - 14:30Tue, Wed, Thu
Sheet5
Cell Formulas
RangeFormula
J3:J13J3=MaxShifts(C3:I3)
K3:K13K3=DaysOff($C$1:$I$1,C3:I3)
Click to expand...
its bang on target. thanks once again.
 
Upvote 0
@Crystalyzer

by any change can we do it for a column the time as 15:00 - 21:00

like we have sun, mon, tue... sat

thanks
 
Upvote 0
I'm not sure I understand what your asking. Can you post a screen shot or XL2BB of the data?
 
Upvote 0
Crystalyzer said:
I'm not sure I understand what your asking. Can you post a screen shot or XL2BB of the data?
Click to expand...
SundayMondayTuesdayWednesdayThursdayFridaySaturday
IDName
7/11/2021​
7/12/2021​
7/13/2021​
7/14/2021​
7/15/2021​
7/16/2021​
7/17/2021​
1​
aOFF1500-21001500-21001500-21001500-21001500-21001200-2100
2bOFFOFFOFFOFFOFFOFFOFF
3cOFF0800-18300800-18300800-18300800-1830OFFOFF
4d0700-15300700-1530OFFOFF0700-15300700-15300700-1530
5e0700-11001030-1430OFFOFFOFF1030-14300700-1100
6fOFF0900-17000900-17000900-17000900-17000900-1700OFF
7g1630-0100OFFOFF1630-01001630-0100No longer employed1630-0100
8h1000-18301000-18301000-1830OFFOFF1000-1830Suspended
13mOFFLeave of absenceLeave of absenceLeave of absenceLeave of absenceLeave of absenceOFF
13m0615-14450600-14300630-1500OFFOFF0700-15300645-1515
13m0700-11001030-1430OFFOFFOFF1030-14300700-1100

can the time be changed to 07:00 - 15:30 instead of 0700-1530.
so in every column (Sunday to Saturday) the time format need to be changed

I hope now i am clear, :)
 
Upvote 0
yes clear as a bell now. I will review and let you know what might need to change if anything.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Macro for copying data from multiple sheets to a common sheet based on a cell value
Replies
0
Views
412
jmk15315
J
J
  • Question Question
FIND AND REPLACE
Replies
1
Views
303
Muhammad_Usman
Muhammad_Usman
M
  • Question Question
Count occurrences - Backwards compatible solutions
Replies
3
Views
333
morrowj04
M
J
  • Solved
Formula Filled Dates
Replies
4
Views
479
Fluff
Fluff
K
  • Solved
Populate Dates and Data With Criteria
2
Replies
11
Views
164
Alex Blakenburg
A

Forum statistics

Threads
1,223,896
Messages
6,175,264
Members
452,627
Latest member
KitkatToby

Share this page

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