[RESOLVED] [EXCEL] Find then subtract

I have this data on a worksheet

Attachment 78658

I want to be able to calculate the elapsed time per status change (i.e. from Open to the last Assigned To, from the last Assigned To to the last Pending Testing) which can be output on a new column, new worksheet, wherever as long as the output will look like this (this is in a new worksheet):

Attachment 78660

I need a code since there may be a lot of records and I need to be able to do it with just a simple push of a button.

Help? :confused:

you can try like this

vb Code:

mystr = Range("c2")
r = 2
For Each c In Range("C3:c99")  ' change to last row +1
  If Not c = mystr Then curstr = c: nex = c.Row
  If Not c = curstr Then
    etime = DateDiff("s", Cells(c.Row - 1, 3), Cells(r, 3))
    edays = DateDiff("d", Cells(c.Row - 1, 3), Cells(r, 3))
    ehours = edays = DateDiff("h", Cells(c.Row - 1, 3), Cells(r, 3)) - edays * 24
    emins = DateDiff("n", Cells(c.Row - 1, 3), Cells(r, 3)) - (edays * 24 + ehours) * 60
    esec = etime - ((edays * 24 + ehours) * 60 + emins) * 60
    Cells(c.Row - 1, 4) = edays
    Cells(c.Row - 1, 5) = ehours
    Cells(c.Row - 1, 5) = emins
    Cells(c.Row - 1, 7) = esec
    r = nex
    mystr = curstr
  End If
Next

you could put formula in the cells instead of calculating the times, i have not tested this for correct calculation or looping, but it should basically work, you can either copy all to new sheet first then run the code, or incorporate coping each row to new sheet as you go

Thanks westconn1! But it didn't work :( I even changed C2 to B2 and the range to B - thinking that this might be comparing the status changes. Am I right? But still didn't do anything.

Where will it output as per the code?

Quote:

---

I even changed C2 to B2 and the range to B - thinking that this might be comparing the status changes

---

that would have been correct
and line 13 should have been column 6
can you post a sample workbook to test with?
(save as .xls and zip)

Here's a workbook for testing. I've already attached the code in VB Editor and tried it but didn't do any change.

I really appreciate your help :)

Attachment 78704

i fixed the code so it now works, but seconds can not be evaluated correctly (and cause an error in calculation) as they are not included in the date /time stamp

check all results carefully

vb Code:

mystr = Range("B3")
r = 2
lastrow = Range("b65535").End(xlUp).Row
For Each c In Range("B3:B" & lastrow + 1) ' change to last row +1
    
    If Not c = mystr Then
        etime = DateDiff("n", Cells(r, 3), Cells(c.Row - 1, 3))
        ehrs = etime \ 60
        emins = etime - ehrs * 60
        edays = ehrs \ 24
        ehrs = ehrs - edays * 24
        Cells(c.Row - 1, 4) = edays
        Cells(c.Row - 1, 5) = ehrs
        Cells(c.Row - 1, 6) = emins
        Cells(c.Row - 1, 7) = esec
        r = nex
        mystr = c
        Else
            nex = c.Row
    End If
Next

tested in your sample sheet

The use of DateDiff() is complicated in this case.

Code:

---

Option Explicit

Private Sub CommandButton1_Click()
    Dim Status  As String
    Dim dStart  As Date
    Dim Elapsed As Date
    Dim r      As Long
   
    Status = Cells(2, 2)
    dStart = Cells(2, 3)
    r = 3
    Do While Cells(r, 2) <> ""
        If Cells(r, 2) <> Status Then
            Elapsed = Cells(r, 3) - dStart
            Cells(r, 4) = Int(Elapsed) '-- extract days as the integer part of Elapsed
                                      '-- cannot use Day(Elapsed), it's wrong
            Cells(r, 5) = Hour(Elapsed)
            Cells(r, 6) = Minute(Elapsed)
            Cells(r, 7) = Second(Elapsed)
            Status = Cells(r, 2)
            dStart = Cells(r, 3)
        Else
            Cells(r, 4).Resize(, 4).ClearContents
        End If
        r = r + 1
    Loop
End Sub

---

I modified westconn1's code to a little bit.

The results display correctly (every last change of status - the last "assigned to", the last "pending", etc.) but now all I get are 0s as results.

Here's the modified code

vb Code:

Private Sub CommandButton2_Click()
 
mystr = Workbooks("report.xls").Worksheets("Sheet2").Range("B3")
 
r = 2
 
lastrow = Workbooks("report.xls").Worksheets("Sheet2").Range("b65535").End(xlUp).Row
 
For Each c In Workbooks("report.xls").Worksheets("Sheet2").Range("B3:B" & lastrow + 1) ' change to last row +1
 
    date1 = Workbooks("report.xls").Worksheets("Sheet2").Cells(r, 3).Value
    date2 = Cells(c.Row - 1, 3).Value
 
 
    If Not c = mystr Then
    etime = DateDiff("n", Cells(r, 3), Cells(c.Row - 1, 3))
    ehrs = etime \ 60
    emins = etime - ehrs * 60
    edays = ehrs \ 24
    esec = ehrs - edays * 24
    Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 4) = edays
    Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 5) = ehrs
    Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 6) = emins
    Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 7) = esec
    r = nex
    mystr = c
    Else
        nex = c.Row
    End If
    
Next
 
 
End Sub

Thanks for your help westconn1 and anhn!

I tried anhn's too, but the results for his shows up on the first instance of change of status.

i ran the code as posted above (#8) against the workbook you posted previously, with correct results

What if my data are in another sheet? I think this is why I'm getting all 0s as a result. The datediff isn't working properly.

I dim date1 and date 2 to replace

etime = DateDiff("n", Cells(r, 3), Cells(c.Row - 1, 3))

Is there any way to do this?

if the data is in another sheet you must specify the sheet by name or index, or use a steet object

Here's what I did but not working:

Code:

---

    date1 = Workbooks("report.xls").Worksheets("Sheet2").Cells(r, 3).Value
    date2 = Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 3).Value
   
    If Not c = mystr Then
    etime = DateDiff("n", Cells(r, 3), Cells(c.Row - 1, 3))

---

you assign values to date1 and date2, but you do not use then in the above example

etime is calculated using values in the activesheet

i would set sheet objects for each sheet then work with the object

vb Code:

set sht1 = Workbooks("report.xls").Worksheets("Sheet2")
etime = DateDiff("n", sht1.Cells(r, 3), sht1.Cells(c.Row - 1, 3))

in this the values are taken from a specific sheet

but as c is a range object it is always on the sheet that is looped through, which may not be the same sheet

vb Code:

Range("D3:G3").Select
    Selection.Copy
    Range("D4:G8").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("D4").Select

for this snippet you need to give just two inputs one is the formula range and the other one is the data range

@westconn1 : that's what I originally did. But I get a "Type mismatch" error.

As for the code i provided, it should've been like this:

Code:

---

    date1 = Workbooks("report.xls").Worksheets("Sheet2").Cells(r, 3).Value
    date2 = Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 3).Value
   
    If Not c = mystr Then
    etime = DateDiff("n", date1, date2)

---

But even that one results to an error.

Here's how it looks like now (and I get the error):

Code:

---

Private Sub CommandButton2_Click()


mystr = Workbooks("report.xls").Worksheets("Sheet2").Range("B3")

r = 2

lastrow = Workbooks("report.xls").Worksheets("Sheet2").Range("b65535").End(xlUp).Row

Set sht1 = Workbooks("report.xls").Worksheets("Sheet2")

For Each c In Workbooks("report.xls").Worksheets("Sheet2").Range("B3:B" & lastrow + 1)
   
    If Not c = mystr Then
    etime = DateDiff("n", sht1.Cells(r, 3), sht1.Cells(c.Row - 1, 3))
    ehrs = etime \ 60
    emins = etime - ehrs * 60
    edays = ehrs \ 24
    ehrs = ehrs - edays * 24
   
    Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 4) = edays
    Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 5) = ehrs
    Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 6) = emins
    Workbooks("report.xls").Worksheets("Sheet2").Cells(c.Row - 1, 7) = esec
   
    r = nex
    mystr = c
   
    Else
        nex = c.Row
    End If
   
Next

 
End Sub

---

Quote:

---

Here's how it looks like now (and I get the error):

---

which line?

i ran the code you posted in #15, just changed workbook and sheet names to suit
no errors, but i did not check the results

you can change the code to fully use the sht1 object

vb Code:

Set sht1 = Workbooks("vb.xls").Worksheets("Sheet1")
mystr = sht1.Range("B3")
r = 2
lastrow = sht1.Range("b65535").End(xlUp).Row
 
For Each c In sht1.Range("B3:B" & lastrow + 1)
    
    If Not c = mystr Then
    etime = DateDiff("n", sht1.Cells(r, 3), sht1.Cells(c.Row - 1, 3))
    ehrs = etime \ 60
    emins = etime - ehrs * 60
    edays = ehrs \ 24
    ehrs = ehrs - edays * 24
    sht1.Cells(c.Row - 1, 4) = edays
    sht1.Cells(c.Row - 1, 5) = ehrs
    sht1.Cells(c.Row - 1, 6) = emins
    sht1.Cells(c.Row - 1, 7) = esec
    r = nex
    mystr = c
    
    Else
        nex = c.Row
    End If
Next

I think it's working okay now. Except the results sometimes are incorrect.

Last question, whats "nex" in line 18 and 22. I wasn't able to dim it and i think that's what's causing the incorrect values.

Oops, nevermind. Solved it! Thank you so much for your help and patience, westconn1!