Time allocation based 2 times

adriga · Jun 23rd 2016

Hi all,

Since it is the first time I posted here, I hope I got all the rules in check.

As I mentioned in my keyword, I am dealing with problem of allocating minutes into three time range (shift's time in a factory).
I have attached file containing the problem that I am dealing and the example and macro which I have written. Thus far, I am only able to use my macro to deal with several possibilities but not all the possibilities.

What I would like to ask:
1. Is there any better approach than the code that I have made?
2. How to solve the yet solved example that I have the attached file?

Please take a look at my excel as I hope it would be clearer to what I would like to achieve rather than explaining here in words. The code that I have is written below.

Thank you in advance.

Code

Sub allocatetime()




Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual




Dim ws1 As Worksheet




Set ws1 = Worksheets("Sheet1")




For i = 16 To 20
    ws1.Cells(i, 7) = WeekdayName(Weekday(ws1.Cells(i, 3), vbMonday), True, vbMonday)
    ws1.Cells(i, 8) = WeekdayName(Weekday(ws1.Cells(i, 5), vbMonday), True, vbMonday)
    
    '--------------------------------------------------------------------------------
    'Calculate shift
    '--------------------------------------------------------------------------------
    'Relate Start Date with Limit Time
    limtim1 = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, 7), "hh:mm:ss") 'Check-out time shift 1
    limtim2 = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, 8), "hh:mm:ss") 'Check-out time shift 2
    limtim3 = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, 9), "hh:mm:ss") 'Check-out time shift 3
    
    'Relate End Date with Limit Time
    limtim4 = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, 7), "hh:mm:ss") 'Check-out time shift 1
    limtim5 = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, 8), "hh:mm:ss") 'Check-out time shift 2
    limtim6 = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, 9), "hh:mm:ss") 'Check-out time shift 3
    
    malf_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(i, 4), "hh:mm:ss")
    malf_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(i, 6), "hh:mm:ss")
    
    'Calculate shift's for start date
    '***********************************************************
    chc1 = DateDiff("h", malf_st, limtim1)
    If chc1 > 0 Then
        If DateDiff("h", malf_st, limtim1) > 8 Then
            If ws1.Cells(i, 7) <> "Mon" Then
                shift_malf_st = 3
            Else
                shift_malf_st = 1
            End If
        Else
            shift_malf_st = 1
        End If
    Else
        chc2 = DateDiff("h", malf_st, limtim2)
        If chc2 < -8 Then
            If ws1.Cells(i, 7) <> "Mon" Then
                shift_malf_st = 3
            Else
                shift_malf_st = 1
            End If
        Else
            If chc2 > 0 Then
                shift_malf_st = 2
            Else
                shift_malf_st = 3
            End If
        End If
    End If
    ws1.Cells(i, 9) = shift_malf_st




    'Calculate shift's for end date
    '***********************************************************
    chc1 = DateDiff("h", malf_en, limtim4)
    If chc1 > 0 Then
        If DateDiff("h", malf_en, limtim4) > 8 Then
            If ws1.Cells(i, 8) <> "Mon" Then
                shift_malf_en = 3
            Else
                shift_malf_en = 1
            End If
        Else
            shift_malf_en = 1
        End If
    Else
        chc2 = DateDiff("h", malf_en, limtim5)
        If chc2 < -8 Then
            If ws1.Cells(i, 8) <> "Mon" Then
                shift_malf_en = 3
            Else
                shift_malf_en = 1
            End If
        Else
            If chc2 > 0 Then
                shift_malf_en = 2
            Else
                shift_malf_en = 3
            End If
        End If
    End If
    ws1.Cells(i, 10) = shift_malf_en




    'Malfunction Duration
    '***********************************************************
    sf_cont = Abs(ws1.Cells(i, 10) - ws1.Cells(i, 9))
    dy_cont = ws1.Cells(i, 5) - ws1.Cells(i, 3)
    
    If sf_cont = 0 Then 'Start & end in same shift
        If dy_cont = 0 Then 'Start & end in same day
            For j = 11 To 13
                If shift_malf_st = Right(ws1.Cells(15, j), 1) * 1 Then
                    ws1.Cells(i, j) = DateDiff("n", malf_st, malf_en)
                Else
                    ws1.Cells(i, j) = 0
                End If
            Next j
        Else 'Start & end not in the same day
            For j = 11 To 13
                If shift_malf_st = Right(ws1.Cells(15, j), 1) * 1 Then
                    If shift_malf_st = 3 Then
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    Else
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    End If
                    
                    ws1.Cells(i, j) = DateDiff("n", malf_st, limtim_st) + (dy_cont - 1) * 8 * 60 + _
                                      Abs(DateDiff("n", limtim_en, malf_en))
                Else
                    ws1.Cells(i, j) = (dy_cont) * 8 * 60
                End If
            Next j
        End If
    Else 'Not in the same shift
        If dy_cont = 0 Then
            ws1.Range(ws1.Cells(i, 11), ws1.Cells(i, 12)).ClearContents
            
            'Start Time
            For j = 11 To 13
                If shift_malf_st = Right(ws1.Cells(15, j), 1) * 1 Then
                    If shift_malf_st = 3 Then
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    Else
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    End If
                    
                    ws1.Cells(i, j) = ws1.Cells(i, j) + DateDiff("n", malf_st, limtim_st)
                Else
                    ws1.Cells(i, j) = ws1.Cells(i, j) + (dy_cont) * 8 * 60
                End If
            Next j
            
            'End Time
            For j = 11 To 13
                If shift_malf_en = Right(ws1.Cells(15, j), 1) * 1 Then
                    If shift_malf_en = 3 Then
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    Else
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    End If
                    
                    ws1.Cells(i, j) = ws1.Cells(i, j) + Abs(DateDiff("n", malf_en, limtim_en))
                Else
                    ws1.Cells(i, j) = ws1.Cells(i, j) + (dy_cont) * 8 * 60
                End If
            Next j
        Else
        '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
        'NOT YET SOLVED
        '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
            'Start Time
            ws1.Range(ws1.Cells(i, 11), ws1.Cells(i, 12)).ClearContents
            For j = 11 To 13
                If shift_malf_st = Right(ws1.Cells(15, j), 1) * 1 Then
                    If shift_malf_st = 3 Then
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    Else
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    End If
                    
                    ws1.Cells(i, j) = ws1.Cells(i, j) + DateDiff("n", malf_st, limtim_st)
                Else
                    ws1.Cells(i, j) = ws1.Cells(i, j) + (dy_cont) * 8 * 60
                End If
            Next j
            
            'End Time
            For j = 11 To 13
                If shift_malf_en = Right(ws1.Cells(15, j), 1) * 1 Then
                    If shift_malf_en = 3 Then
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    Else
                        limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                        limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                    End If
                    
                    ws1.Cells(i, j) = ws1.Cells(i, j) + Abs(DateDiff("n", malf_en, limtim_en))
                Else
                    ws1.Cells(i, j) = ws1.Cells(i, j) + (dy_cont) * 8 * 60
                End If
            Next j
        '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
        End If
    End If
    '-------------------------------------------------------------------------------
Next i




Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True








End Sub

Display More

adriga · Jun 23rd 2016

Re: Time allocation based on two time entry

I think I have solved my own question..

Although I think it is not yet efficient, seeing from the number of lines involved in my code below..

But at least it works.. :D.

If anyone have any idea or other approach to make it more efficient , please share it here..

The code can be used with the file I have shared previously.

Thanks

Code

Sub allocatetime()




Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual




Dim ws1 As Worksheet




Set ws1 = Worksheets("Sheet1")




For i = 16 To 20
    ws1.Cells(i, 7) = WeekdayName(Weekday(ws1.Cells(i, 3), vbMonday), True, vbMonday)
    ws1.Cells(i, 8) = WeekdayName(Weekday(ws1.Cells(i, 5), vbMonday), True, vbMonday)
    
    '--------------------------------------------------------------------------------
    'Calculate shift
    '--------------------------------------------------------------------------------
    'Relate Start Date with Limit Time
    limtim1 = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, 7), "hh:mm:ss") 'Check-out time shift 1
    limtim2 = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, 8), "hh:mm:ss") 'Check-out time shift 2
    limtim3 = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, 9), "hh:mm:ss") 'Check-out time shift 3
    
    'Relate End Date with Limit Time
    limtim4 = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, 7), "hh:mm:ss") 'Check-out time shift 1
    limtim5 = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, 8), "hh:mm:ss") 'Check-out time shift 2
    limtim6 = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, 9), "hh:mm:ss") 'Check-out time shift 3
    
    malf_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(i, 4), "hh:mm:ss")
    malf_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(i, 6), "hh:mm:ss")
    
    'Calculate shift's for start date
    '***********************************************************
    chc1 = DateDiff("h", malf_st, limtim1)
    If chc1 > 0 Then
        If DateDiff("h", malf_st, limtim1) > 8 Then
            If ws1.Cells(i, 7) <> "Mon" Then
                shift_malf_st = 3
            Else
                shift_malf_st = 1
            End If
        Else
            shift_malf_st = 1
        End If
    Else
        chc2 = DateDiff("h", malf_st, limtim2)
        If chc2 < -8 Then
            If ws1.Cells(i, 7) <> "Mon" Then
                shift_malf_st = 3
            Else
                shift_malf_st = 1
            End If
        Else
            If chc2 > 0 Then
                shift_malf_st = 2
            Else
                shift_malf_st = 3
            End If
        End If
    End If
    ws1.Cells(i, 9) = shift_malf_st




    'Calculate shift's for end date
    '***********************************************************
    chc1 = DateDiff("h", malf_en, limtim4)
    If chc1 > 0 Then
        If DateDiff("h", malf_en, limtim4) > 8 Then
            If ws1.Cells(i, 8) <> "Mon" Then
                shift_malf_en = 3
            Else
                shift_malf_en = 1
            End If
        Else
            shift_malf_en = 1
        End If
    Else
        chc2 = DateDiff("h", malf_en, limtim5)
        If chc2 < -8 Then
            If ws1.Cells(i, 8) <> "Mon" Then
                shift_malf_en = 3
            Else
                shift_malf_en = 1
            End If
        Else
            If chc2 > 0 Then
                shift_malf_en = 2
            Else
                shift_malf_en = 3
            End If
        End If
    End If
    ws1.Cells(i, 10) = shift_malf_en




    'Malfunction Duration
    '***********************************************************
    ws1.Range(ws1.Cells(i, 11), ws1.Cells(i, 13)).ClearContents
    
    date_count = ws1.Cells(i, 3)
    
    Do While date_count <= ws1.Cells(i, 5)
        For j = 11 To 13
            day_ct = WeekdayName(Weekday(date_count, vbMonday), True, vbMonday)
            If day_ct = "Sun" Then
                ws1.Cells(i, j) = ws1.Cells(i, j) + 0 'Any shift, adding zero
            Else
                If ws1.Cells(i, 3) <> ws1.Cells(i, 5) Then
                    If date_count < ws1.Cells(i, 5) Then 'if date less than end date, then within interval
                        If date_count = ws1.Cells(i, 3) Then 'if date same with start date
                            If Right(ws1.Cells(15, j), 1) * 1 = ws1.Cells(i, 9) Then
                                If shift_malf_st = 3 Then
                                    limtim_st = ws1.Cells(i, 3) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                                    limtim_en = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                                Else
                                    limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                                    limtim_en = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                                End If
                                
                                ws1.Cells(i, j) = ws1.Cells(i, j) + DateDiff("n", malf_st, limtim_en)
                            Else 'not at the same shift
                                If Right(ws1.Cells(15, j), 1) * 1 < ws1.Cells(i, 9) Then
                                    ws1.Cells(i, j) = ws1.Cells(i, j) + 0 'Any shift, adding zero
                                Else
                                    ws1.Cells(i, j) = ws1.Cells(i, j) + 480
                                End If
                            End If
                        Else 'the date is bigger than start date but less than end date
                            'If Right(ws1.Cells(15, j), 1) * 1 = ws1.Cells(i, 9) Then
                                ws1.Cells(i, j) = ws1.Cells(i, j) + 480
                            'End If
                        End If
                    Else
                        If date_count = ws1.Cells(i, 5) Then
                            If Right(ws1.Cells(15, j), 1) * 1 = ws1.Cells(i, 10) Then
                                If shift_malf_en = 3 Then
                                    limtim_st = ws1.Cells(i, 5) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                                    limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                                Else
                                    limtim_st = ws1.Cells(i, 5) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                                    limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                                End If
                                
                                ws1.Cells(i, j) = ws1.Cells(i, j) + DateDiff("n", limtim_st, malf_en)
                            Else
                                If Right(ws1.Cells(15, j), 1) * 1 > ws1.Cells(i, 10) Then
                                    ws1.Cells(i, j) = ws1.Cells(i, j) + 0 'Any shift, adding zero
                                Else
                                    ws1.Cells(i, j) = ws1.Cells(i, j) + 480
                                End If
                            End If
                        Else
                            ws1.Cells(i, j) = ws1.Cells(i, j) + 0
                        End If
                    End If
                Else
                    If ws1.Cells(i, 9) = ws1.Cells(i, 10) Then
                        If ws1.Cells(i, 9) = Right(ws1.Cells(15, j), 1) * 1 Then
                            ws1.Cells(i, j) = DateDiff("n", malf_st, malf_en)
                        Else
                            ws1.Cells(i, j) = 0
                        End If
                    Else
                        If ws1.Cells(i, 9) = Right(ws1.Cells(15, j), 1) * 1 Then
                            If shift_malf_st = 3 Then
                                limtim_st = ws1.Cells(i, 3) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                                limtim_en = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                            Else
                                limtim_st = ws1.Cells(i, 3) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                                limtim_en = ws1.Cells(i, 3) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                            End If
                            
                            ws1.Cells(i, j) = ws1.Cells(i, j) + DateDiff("n", malf_st, limtim_en)
                        Else
                            ws1.Cells(i, j) = ws1.Cells(i, j) + 0
                        End If
                        
                        If ws1.Cells(i, 10) = Right(ws1.Cells(15, j), 1) * 1 Then
                            If shift_malf_en = 3 Then
                                limtim_st = ws1.Cells(i, 5) - 1 & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                                limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                            Else
                                limtim_st = ws1.Cells(i, 5) & " " & Format(ws1.Cells(1, j - 4), "hh:mm:ss")
                                limtim_en = ws1.Cells(i, 5) & " " & Format(ws1.Cells(2, j - 4), "hh:mm:ss")
                            End If
                            
                            ws1.Cells(i, j) = ws1.Cells(i, j) + DateDiff("n", limtim_st, malf_en)
                        Else
                            ws1.Cells(i, j) = ws1.Cells(i, j) + 0
                        End If
                    End If
                End If
            End If
        Next j
        date_count = date_count + 1
    Loop
    '-------------------------------------------------------------------------------
Next i




Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True








End Sub

Display More

Time allocation based 2 times

Participate now!

Share