Speed Up this Code (Takes over 15 minutes)

U

Uzma Shaheen

Active Member
Joined
Nov 10, 2012
Messages
484
Office Version
  1. 365
  2. 2021
Platform
  1. Windows
  2. Mobile
  3. Web
Hi Guys

Hope you guys are well and could help me speed up this code.
I am not sure if i can speed it up any further so hoping you guys can come up with something. The loop can be looping over 400,000 rows hence the reason why it takes longer.
This code works fine other than taking longer to loop over many rows.

This is what i am doing in the code

1) I am trying to get the start and end time for each agent per day (If an agent started at 22:00:00 on 17/10/2016 and finished at 06:00:00 on 18/10/2016, the end date will show as 17/10/2016 06:00:00 because the shift is still part of the 17/10/2016 working day

2) I am also trying to get the start and end time of lunches if there was any lunch taken

3) Lastly – I have a time range where if an agent worked during a certain time period, and they fall into a specific time range category, they would get a certain % extra in pay therefore needed to capture how much time was worked in that time range criteria however I have an exception list to compare with because if the task code is 1 of these exception codes, then i can ignore it (Anything other than what is in the exception list should not be counted and anything else, i need to compare the times worked from/to and put into to the category.

I didn’t know how to do this part so I created a sheet that listed every minute from 00:00:00 to 36:00:00 and then had a formula like this to compare the start and end time

Code: 
=IF(AND($C$2<=F1,$D$2>F1),1,0)

I then had a sumif formula across these cells to add up the minutes
00:00:00
06:00:00
08:00:00
20:00:00
22:00:00
12:00:00
0
0
0
0
4

<tbody>
</tbody>

Code: 
=ROUND(SUMIFS($G$1:$G$1951,$F$1:$F$1951,">="&I1,$F$1:$F$1951,"<"&J1)/60,2)

I have a named range called Exceptions


Now – i did not know another way of doing it until i had a formula from Eric yesterday that did something like this which i could include into this code

Start
End
Ranges
Overlap
21:00
06:00
06:00:00
08:00:00
00:00

08:00:00
20:00:00
00:00

20:00:00
22:00:00
01:00

22:00:00
23:59:59
01:59

00:00:00
06:00:00
06:00

<tbody>
</tbody>

Code: 
Formula =  =MAX(0,MIN(IF($C$2<$B$2,1,$C$2),$F2)-MAX($B$2,$E2))+IF($C$2<$B$2,MAX(0,MIN($C$2,$F2)-MAX(0,$E2)),0)

Now i hope this is enough information to help me speed up this code
I could not find any way of getting all the times worked except the exception codes to be able to see what times they worked and what time range that falls into hence the reason why i added an if function to first have the start time as the start time and end time the start of the lunch time (if there was a lunch)
I then added the end time of the lunch as the start time for the 2nd bit and added the end time of the shift as the end time

I have a function to take any overlapped time into account if an agent started at 22:00:00 and finished after midnight

This is a small sample of the data set and the Code that is working (Range A to O)

Shift Date EndedShift Date StartedTZcustIDmuIDtvIDacdIDlogonIDssnagentNamemodifyTaskstartstopexternalID
01/10/201630/09/2016GB170049414409232361209414409Ahern, Gemma1472108778Managing22:0001:45GAHERN1
01/10/201630/09/2016GB170049414409232361209414409Ahern, Gemma1472108778Lunch01:4502:15GAHERN1
01/10/201630/09/2016GB170049414409232361209414409Ahern, Gemma1472108778Managing02:1506:00GAHERN1
03/10/201603/10/2016GB170049414409232361209414409Ahern, Gemma1471941488Managing08:3012:00GAHERN1
03/10/201603/10/2016GB170049414409232361209414409Ahern, Gemma1471941488Lunch12:0012:30GAHERN1
03/10/201603/10/2016GB170049414409232361209414409Ahern, Gemma1471941488Managing12:3016:00GAHERN1
04/10/201604/10/2016GB170049414409232361209414409Ahern, Gemma1471941488Managing08:3010:00GAHERN1
04/10/201604/10/2016GB170049414409232361209414409Ahern, Gemma1471941488Comms Cell (P)10:0011:00GAHERN1
04/10/201604/10/2016GB170049414409232361209414409Ahern, Gemma1471941488Managing11:0012:00GAHERN1
04/10/201604/10/2016GB170049414409232361209414409Ahern, Gemma1471941488Lunch12:0012:30GAHERN1
04/10/201604/10/2016GB170049414409232361209414409Ahern, Gemma1471941488Managing12:3016:00GAHERN1
05/10/201605/10/2016GB170049414409232361209414409Ahern, Gemma1471941489Flex08:0009:00GAHERN1
05/10/201605/10/2016GB170049414409232361209414409Ahern, Gemma1471941489Managing09:0012:30GAHERN1
05/10/201605/10/2016GB170049414409232361209414409Ahern, Gemma1471941489Lunch12:3013:00GAHERN1
05/10/201605/10/2016GB170049414409232361209414409Ahern, Gemma1471941489Managing13:0016:30GAHERN1
06/10/201606/10/2016GB170049414409232361209414409Ahern, Gemma1471941490Flex08:0009:00GAHERN1
06/10/201606/10/2016GB170049414409232361209414409Ahern, Gemma1471941490Managing09:0012:30GAHERN1
06/10/201606/10/2016GB170049414409232361209414409Ahern, Gemma1471941490Lunch12:3013:00GAHERN1
06/10/201606/10/2016GB170049414409232361209414409Ahern, Gemma1471941490Managing13:0016:30GAHERN1
07/10/201607/10/2016GB170049414409232361209414409Ahern, Gemma1471941490Managing08:3012:00GAHERN1
07/10/201607/10/2016GB170049414409232361209414409Ahern, Gemma1471941490Lunch12:0012:30GAHERN1
07/10/201607/10/2016GB170049414409232361209414409Ahern, Gemma1471941490Managing12:3016:00GAHERN1
10/10/201610/10/2016GB170049414409232361209414409Ahern, Gemma1471942576Managing06:0009:45GAHERN1
10/10/201610/10/2016GB170049414409232361209414409Ahern, Gemma1471942576Lunch09:4510:15GAHERN1
10/10/201610/10/2016GB170049414409232361209414409Ahern, Gemma1471942576Managing10:1514:00GAHERN1
11/10/201611/10/2016GB170049414409232361209414409Ahern, Gemma1471942577Managing06:0009:30GAHERN1
11/10/201611/10/2016GB170049414409232361209414409Ahern, Gemma1471942577Lunch09:3010:00GAHERN1
11/10/201611/10/2016GB170049414409232361209414409Ahern, Gemma1471942577Comms Cell (P)10:0011:00GAHERN1
11/10/201611/10/2016GB170049414409232361209414409Ahern, Gemma1471942577Managing11:0014:00GAHERN1

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Here is the Code:

Code: 
' main loop which copies data to NewSummary sheet
Private Sub COSCPayrollLoop()
    Dim agentName As String
    Dim agentID As Long
    Dim agentShift As Long          ' date of shift start
    Dim agentStart As Double        ' start time
    Dim agentEnd As Double          ' end time
    Dim agentLunchStart As Double   ' start of lunch (if they have one)
    Dim agentLunchEnd As Double     ' end of lunch (if they have one)
    Dim lCounter As Long            ' total rows to go through
    Dim lCurrent As Long            ' which row are we currently looking at
    Dim lPasteLine As Long          ' where we're pasting to next (on NewSummary)
    Dim iException As Integer       ' to count if a code is to be ignored
    Dim bnPrint As Boolean          ' should we print this agents detail
    
    ' count the number of rows we're looking, setup start of read row & where to paste to
    lCounter = Worksheets("COSC").Range("A1048576").End(xlUp).Row
    lCurrent = 2
    lPasteLine = 3
    
    ' set certain values to a NULL value
    agentStart = -1
    agentEnd = -1
    agentLunchStart = -1
    agentLunchEnd = -1
    bnPrint = False
       
    ' loop from start to end
    Do Until lCurrent > lCounter
        Application.StatusBar = lCurrent & "/" & lCounter


    ' this if statement runs if current Date & Agent are the same as the next row
        If Worksheets("COSC").Range("J" & lCurrent + 1) = Worksheets("COSC").Range("J" & lCurrent) _
         And Worksheets("COSC").Range("B" & lCurrent + 1) = Worksheets("COSC").Range("B" & lCurrent) Then
    
    ' we check if the exception code is on the DON'T USE list on TimeSplit sheet
            iException = WorksheetFunction.CountIf(Worksheets("TimeSplit").Range("S:S"), Worksheets("COSC").Range("L" & lCurrent))
    ' if the code IS NOT on that list
            If iException < 1 Then
    
    ' if we don't yet have anything for agent start time then setup name, ID, date & start time - this will run once per person per day
                If agentStart < 0 Then
                    agentName = Worksheets("COSC").Range("J" & lCurrent)
                    agentID = Worksheets("COSC").Range("F" & lCurrent)
                    agentShift = Worksheets("COSC").Range("B" & lCurrent)
                    agentStart = TwentyFourHourTime(Worksheets("COSC").Range("B" & lCurrent), Worksheets("COSC").Range("A" & lCurrent), Worksheets("COSC").Range("M" & lCurrent))
                End If
            
    ' set the end time - this will be updated for every line that belongs to this agent for this day 0 & set print as true
                agentEnd = TwentyFourHourTime(Worksheets("COSC").Range("B" & lCurrent), Worksheets("COSC").Range("A" & lCurrent), Worksheets("COSC").Range("N" & lCurrent))
                bnPrint = True
            End If
            
    ' if code is lunch then set the start & stop times
            If Worksheets("COSC").Range("L" & lCurrent) = "Lunch" Then
                agentLunchStart = TwentyFourHourTime(Worksheets("COSC").Range("B" & lCurrent), Worksheets("COSC").Range("A" & lCurrent), Worksheets("COSC").Range("M" & lCurrent))
                agentLunchEnd = TwentyFourHourTime(Worksheets("COSC").Range("B" & lCurrent), Worksheets("COSC").Range("A" & lCurrent), Worksheets("COSC").Range("N" & lCurrent))
            End If
        
    ' this else statement runs if the current Date or Agent differs with the next on the sheet
        Else
            iException = WorksheetFunction.CountIf(Worksheets("TimeSplit").Range("S:S"), Worksheets("COSC").Range("L" & lCurrent))
            If iException < 1 Then
                agentEnd = TwentyFourHourTime(Worksheets("COSC").Range("B" & lCurrent), Worksheets("COSC").Range("A" & lCurrent), Worksheets("COSC").Range("N" & lCurrent))
            End If
            
    ' only print the details if this is true e.g. we wont print an agent whose just on Overtime the whole day
            If bnPrint = True Then
    
    ' the TimeSplit sheet is used to split the hours into relevant 'pots' of normal 15% and 30%
    ' here we put the agent name & the start of their shift
                Worksheets("TimeSplit").Range("A2") = agentName
                Worksheets("TimeSplit").Range("C2") = agentStart
    
    ' if the agent has a lunch and it starts before the end of the shift then use the lunch time as the 1st 'end time'
                If agentLunchStart <> -1 And agentLunchStart < agentEnd Then
                    Worksheets("TimeSplit").Range("D2") = agentLunchStart
                Else
    ' if not then use the end of the shift
                    Worksheets("TimeSplit").Range("D2") = agentEnd
                End If
            
    ' type in the agents ID, name, shift date, shift start, shift end & lunch (if they have one)
                Worksheets("NewSummary").Range("A" & lPasteLine) = agentID
                Worksheets("NewSummary").Range("B" & lPasteLine) = agentName
                Worksheets("NewSummary").Range("C" & lPasteLine) = agentShift
                Worksheets("NewSummary").Range("D" & lPasteLine) = agentShift
                Worksheets("NewSummary").Range("E" & lPasteLine) = agentStart
                Worksheets("NewSummary").Range("F" & lPasteLine) = agentEnd
                If agentLunchStart <> -1 And agentLunchStart < agentEnd Then
                    Worksheets("NewSummary").Range("G" & lPasteLine) = agentLunchStart
                    Worksheets("NewSummary").Range("H" & lPasteLine) = agentLunchEnd
                End If
            
    ' put in the information from the time pots (this will be from start - lunch (if they have one) or start - end)
                Worksheets("NewSummary").Range("K" & lPasteLine) = Worksheets("TimeSplit").Range("K2")
                Worksheets("NewSummary").Range("L" & lPasteLine) = Worksheets("TimeSplit").Range("J2") + Worksheets("TimeSplit").Range("L2")
                Worksheets("NewSummary").Range("M" & lPasteLine) = Worksheets("TimeSplit").Range("I2") + Worksheets("TimeSplit").Range("M2")
            
    ' if they have a lunch which is before the end of the shift then put lunch end & shift end as the new start / stop time
                If agentLunchStart <> -1 And agentLunchStart < agentEnd Then
                    Worksheets("TimeSplit").Range("C2") = agentLunchEnd
                    Worksheets("TimeSplit").Range("D2") = agentEnd
            
    ' add the information from these time pots to the ones already in
                    Worksheets("NewSummary").Range("K" & lPasteLine) = Worksheets("NewSummary").Range("K" & lPasteLine) + Worksheets("TimeSplit").Range("K2")
                    Worksheets("NewSummary").Range("L" & lPasteLine) = Worksheets("NewSummary").Range("L" & lPasteLine) + Worksheets("TimeSplit").Range("J2") + Worksheets("TimeSplit").Range("L2")
                    Worksheets("NewSummary").Range("M" & lPasteLine) = Worksheets("NewSummary").Range("M" & lPasteLine) + Worksheets("TimeSplit").Range("I2") + Worksheets("TimeSplit").Range("M2")
                End If
    ' move on to the next line to paste
                lPasteLine = lPasteLine + 1
            End If
                
    ' once we've printed an agent set the data below to NULL
            agentStart = -1
            agentEnd = -1
            agentLunchStart = -1
            agentLunchEnd = -1
            bnPrint = False
        End If
        lCurrent = lCurrent + 1
    Loop
    Application.StatusBar = False
End Sub


' called whenever time is being put in - if the time period has one past midnight then add 1 to the time to make it more then 24 hours (e.g. 6am becomes 30:00)
Private Function TwentyFourHourTime(lDate As Long, lShiftDate As Long, dTime As Double) As Double
    Dim dTempTime As Double
    
    dTempTime = dTime
    If lDate < lShiftDate Or dTime = 0 Then dTempTime = dTime + 1
    TwentyFourHourTime = dTempTime
End Function
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
Please advise if i have provided enough information

Hopefully there is a solution to speed it up

Thank you
 
Upvote 0
Try add the following options into your code

Sub speedUpCode()
'Add this at the beginning
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
'Then your code
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Click to expand...
 
Upvote 0
I have done and it still takes around 10 minutes - not sure if its because of looping through so many rows and comparing each row
 
Upvote 0
400,000 ! Yeah, that'll take time.
A great way to speed up an iteration is to work in an array then write the array values to the desired cells.
I have worked with array form with help from Walkenbach's book and have had great improvements. I must admit I'm not able to explain that method well enough or at least better than other sources yet.
 
Upvote 0
Thank you

Is there any chance you could help me with an array approach
 
Upvote 0
Hi

A few observations :-
1, Perhaps the check against Agent Name could be changed to a check against muid, logonid, ssn or externalid, preferably against the first three rather than the last.

2, With this section of code :-
Code: 
        If Worksheets("COSC").Range("J" & lCurrent + 1) = Worksheets("COSC").Range("J" & lCurrent) _
         And Worksheets("COSC").Range("B" & lCurrent + 1) = Worksheets("COSC").Range("B" & lCurrent) Then
it could be more efficient to use Offset as follows :-
Code: 
        If Worksheets("COSC").Range("J" & lCurrent).Offset(1) = Worksheets("COSC").Range("J" & lCurrent) _
         And Worksheets("COSC").Range("B" & lCurrent).Offset(1) = Worksheets("COSC").Range("B" & lCurrent) Then
rather than have two calculations.

3, Perhaps the use of the Worksheet object would help speed things up, for example :-
Code: 
Dim wsCo as Worksheet
Set wsCo = Worksheets("COSC")
then the statement above becomes :-
Code: 
        If wsCo.Range("J" & lCurrent).Offset(1) = wsCo.Range("J" & lCurrent) _
         And wsCo.Range("B" & lCurrent).Offset(1) = wsCo.Range("B" & lCurrent) Then
at the least if it isn't more efficient you improve the readability of your code.

hth
 
Last edited:
Upvote 0
Hi

I made the changes and it speeded it up a little by a minute or so...

Im thinking an array would be the quickest way but not sure..Would really appreciate it if 1 of the gurus can come up with something

thank you all
 
Upvote 0
You must log in or register to reply here.

Similar threads

AOB
  • Question
Calculate the "true" duration of up/down times accounting for gaps and overlaps
Replies
1
Views
292
AOB
AOB
N
  • Question
Need Formula help
Replies
5
Views
384
AhoyNC
A
C
  • Question
Ordinary Hours or Penalty Shift
Replies
0
Views
110
ChetanPuri
C
K
  • Question
Excel Pivot table Time Values is not populating same as Source Sheet
Replies
1
Views
329
awoohaw
awoohaw
A
  • Solved
Macro getting stuck on average when no data is present
Replies
5
Views
260
amphead
A

Forum statistics

Threads
1,215,640
Messages
6,125,976
Members
449,276
Latest member
surendra75

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