VBA to copy row of data based on criteria

JSR1306

New Member
Joined
Sep 15, 2012
Messages
45
Hello,

Hopefully one of you VBA whizzes will be able to solve my problem :)

I have a table of data (See below) that I need to extract data from based on the unique ID number and the time that the specific record breached the SLA due date.

For example: record ID 196664 was due by 30/01/13 at 17:57:00 - The first row that goes past this date and time is row 6 with a date and time of 01/02/13 at 09:34:42. This is then the row I want to copy and paste into a new sheet.

All breaching date times after the first one are not required, I only want to return the first one that breaches SLA Due date.

incident_no
priority
sla_due_date
sla_due_time
status
date_last_updated
time_last_updated
old_status
new_status
date_updated
time_updated
196664
4
30/01/2013
17:57:00
Closed
01/02/2013
09:34:40
Await Cust 1
Await Cust 2
27/01/2013
11:50:44
196664
4
30/01/2013
17:57:00
Closed
01/02/2013
09:34:40
Await Cust 1
Await Cust 2
28/01/2013
17:55:31
196664
4
30/01/2013
17:57:00
Closed
01/02/2013
09:34:40
Await Cust 2
Resolved
29/01/2013
13:52:17
196664
4
30/01/2013
17:57:00
Closed
01/02/2013
09:34:40
Resolved
Escalated to 3rd Party
29/01/2013
13:57:07
196664
4
30/01/2013
17:57:00
Closed
01/02/2013
09:34:40
Escalated to 3rd Party
Closed
01/02/2013
09:34:42
196664
4
30/01/2013
17:57:00
Closed
01/02/2013
09:34:40
Await Cust 2
Await Cust 1
28/01/2013
09:20:29
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Open
Await Cust 1
21/01/2013
14:00:05
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Escalated to 3rd Party
Closed
01/02/2013
10:25:41
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Open
Escalated to 3rd Party
31/01/2013
11:42:50
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Await Cust 2
Escalated to 2nd Line
29/01/2013
16:11:30
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Escalated to 3rd Party
Open
31/01/2013
09:55:53
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Await Cust 1
Await Cust 2
23/01/2013
17:57:18
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Escalated to 2nd Line
Open
30/01/2013
14:27:12
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Open
Escalated to 3rd Party
31/01/2013
08:26:22
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Open
Escalated to 3rd Party
30/01/2013
16:24:21
194531
4
30/01/2013
15:43:00
Closed
01/02/2013
10:45:03
Escalated to 3rd Party
Open
30/01/2013
16:50:42
191877
4
16/01/2013
11:24:00
Closed
01/02/2013
10:55:05
Escalated to 3rd Line
Passed Back
25/01/2013
13:43:33
191877
4
16/01/2013
11:24:00
Closed
01/02/2013
10:55:05
Await Cust 1
Await Cust 2
14/01/2013
10:40:00
191877
4
16/01/2013
11:24:00
Closed
01/02/2013
10:55:05
Passed Back
Escalated to 3rd Line
25/01/2013
11:15:01
191877
4
16/01/2013
11:24:00
Closed
01/02/2013
10:55:05
Await Cust 2
Escalated to 2nd Line
15/01/2013
11:40:54
191877
4
16/01/2013
11:24:00
Closed
01/02/2013
10:55:05
Passed Back
Closed
01/02/2013
10:55:11
191877
4
16/01/2013
11:24:00
Closed
01/02/2013
10:55:05
Open
Await Cust 1
12/01/2013
10:17:54
191877
4
16/01/2013
11:24:00
Closed
01/02/2013
10:55:05
Escalated to 2nd Line
Escalated to 3rd Line
16/01/2013
10:46:22
191877
4
16/01/2013
11:24:00
Closed
01/02/2013
10:55:05
Escalated to 3rd Line
Passed Back
19/01/2013
09:10:03

<tbody>
</tbody>


I appreciate any help.

Many Thanks

John
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Try this :-
Results sheet(2)
Code:
[COLOR="Navy"]Sub[/COLOR] MG24Mar00
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dt1         [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] Dt2         [COLOR="Navy"]As[/COLOR] Double
[COLOR="Navy"]Dim[/COLOR] k
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Dim[/COLOR] oHds
oHds = Range("A1").Resize(, 11).Value
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
Dt1 = CDbl(DateValue(Dn.Offset(, 2)) + Dn.Offset(, 3) / 24)
Dt2 = CDbl(DateValue(Dn.Offset(, 9)) + Dn.Offset(, 10) / 24)
[COLOR="Navy"]If[/COLOR] Dt2 > Dt1 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Dn, Dt2 - Dt1)
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
           [COLOR="Navy"]If[/COLOR] Q(1) < (Dt2 - Dt1) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Q(0) = Dn
                Q(1) = Dt2 - Dt1
            [COLOR="Navy"]End[/COLOR] If
        .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
c = 1
 Sheets("Sheet2").Range("A1").Resize(, 11) = oHds
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
    c = c + 1
    [COLOR="Navy"]For[/COLOR] Ac = 0 To 10
    [COLOR="Navy"]If[/COLOR] Ac = 3 Or Ac = 5 Or Ac = 9 [COLOR="Navy"]Then[/COLOR]
    Sheets("sheet2").Range("A" & c).Offset(, Ac) = Format(.Item(k)(0).Offset(, Ac).Value, "dd/mm/yyyy")
    [COLOR="Navy"]Else[/COLOR]
    Sheets("sheet2").Range("A" & c).Offset(, Ac) = .Item(k)(0).Offset(, Ac).Value
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] With
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks Mick,

It almost does exactly what I was after, however the code is not returning the first row that contains the first date time that is passed the SLA due date.

Ill have a play and see if I can modify it slightly.

Cheers

John
 
Upvote 0
This is the return values on sheet (2) althouigh You need to change the 3 to a 2 as below :-
Rich (BB code):
If Ac = 2 Or Ac = 5 Or Ac = 9 Then

incident_no
priority
sla_due_date
sla_due_time
status
date_last_updated
time_last_updated
old_status
new_status
date_updated
time_updated
196664
4
30/01/2013
17:57:00
Closed
02/01/2013
09:34:40
Escalated to 3rd Party
Closed
02/01/2013
09:34:42
194531
4
30/01/2013
15:43:00
Closed
02/01/2013
10:45:03
Escalated to 3rd Party
Closed
02/01/2013
10:25:41
191877
4
16/01/2013
11:24:00
Closed
02/01/2013
10:55:05
Passed Back
Closed
02/01/2013
10:55:11

<TBODY>
</TBODY>
 
Upvote 0
I changed it but still cant get the right row. It should draw out this row for 194531

194531430/01/201315:43:00Closed01/02/201310:45:03OpenEscalated to 3rd Party30/01/201316:24:21


<tbody>
</tbody>
This is the first Row where time and date updated first exceed SLA due date.

Otherwise the code works perfectly :)
 
Upvote 0
I think the last, two rows where incorrect !!.
Change the line (in red) around as shown below you'll see what I mean if you compare the two lines.

Rich (BB code):
Q = .Item(Dn.Value)
          If Dt2 - Dt1 < Q(1) Then
                Set Q(0) = Dn
 
Upvote 0
Genius works perfectly :)

Thanks for all your help.

Any suggestions on best ways for me to learn vba?

Many Thanks

John
 
Upvote 0
Thanks for the Feed back:- Like most things , get a couple of books and lots of practice !!!
Regrds Mick
 
Upvote 0

Forum statistics

Threads
1,215,467
Messages
6,124,984
Members
449,201
Latest member
Lunzwe73

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