Macro help

[puiuluipui]

Hi, i need a macro to delete all rows except for the smallest and biggest
time in column "B". But i need the code to look in other columns before that.
Some kind of macro criteria.

Ex:
A B C D E
Date Time Station Id Name
01.12.09 08:01:19 IN 5 John
01.12.09 09:05:30 IN 5 John
01.12.09 14:30:58 out 5 John
01.12.09 16:30:19 out 5 John
01.12.09 07:59:23 IN 5 Mary
01.12.09 11:54:20 IN 5 Mary
01.12.09 16:29:13 out 5 Mary
01.12.09 16:34:29 out 5 Mary
02.12.09....
03.12.09....

This is an example for one day (01.12.2009). All days are consecutive.
I need the macro to look first at the "Date", then at "Name", then at the
"Station", then at "Time". I need the smallest "IN" time and the biggest
"out" time.

Result after macro:
01.12.09 08:01:19 IN 5 John
01.12.09 16:30:19 out 5 John
01.12.09 07:59:23 IN 5 Mary
01.12.09 16:34:29 out 5 Mary

Can this be done?
Thanks!

 

[Jacob Skaria]

Try the below macro...with headers in Row1 and data starting from Row 2

Sub DeletetoSummarize()
Dim lngRow As Long, strType As String, lngLastRow As Long
lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For lngRow = lngLastRow To 2 Step -1
If UCase(Trim(Range("C" & lngRow))) = "IN" Then strType = "MIN"
If UCase(Trim(Range("C" & lngRow))) = "OUT" Then strType = "MAX"
If Evaluate("=" & strType & "(IF($A$2:$A$" & lngLastRow & "=A" & _
lngRow & ",IF($E$2:$E$" & lngLastRow & "=E" & lngRow & _
",$B$2:$B$" & lngLastRow & ")))") <> Range("B" & lngRow) Then
Rows(lngRow).Delete
End If
Next
End Sub

 

[puiuluipui]

Hi Jacob, it's working great!.
I have one more question.
Ex: (after your first macro)
A B C D E
01.12.2009 07:53:20 IN 1 John
01.12.2009 08:01:21 OUT 1 John 00:08:01
01.12.2009 08:01:31 IN 2 Mary
01.12.2009 08:01:36 OUT 2 Mary 00:00:05

I need another macro to look in column "E" then in "A" and then to do "out's
time - in's time".
Result:
A B C D E F
01.12.2009 07:53:20 IN 1 John
01.12.2009 08:01:21 OUT 1 John 00:08:01
01.12.2009 08:01:31 IN 2 Mary
01.12.2009 08:01:36 OUT 2 Mary 00:00:05

Can this be done?
Thanks!


"Jacob Skaria" a scris:

 

[Jacob Skaria]

You could try

Sub Macro()
Range("F2:F" & Cells(Rows.Count, 1).End(xlUp).Row).Formula = _
"=IF(C2=""OUT"",B2-B1,"""")"
End Sub

OR try the below..I have modified the previous macro to get this result in
Col F

Sub DeletetoSummarize()
Dim lngRow As Long, strType As String, lngLastRow As Long
lngLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For lngRow = lngLastRow To 2 Step -1
If UCase(Trim(Range("C" & lngRow))) = "IN" Then strType = "MIN"
If UCase(Trim(Range("C" & lngRow))) = "OUT" Then strType = "MAX"
If Evaluate("=" & strType & "(IF($A$2:$A$" & lngLastRow & "=A" & _
lngRow & ",IF($E$2:$E$" & lngLastRow & "=E" & lngRow & _
",$B$2:$B$" & lngLastRow & ")))") <> Range("B" & lngRow) Then
Rows(lngRow).Delete

ElseIf strType = "MAX" Then

Range("F" & lngRow) = Range("B" & lngRow) - _
Evaluate("=MIN(IF($A$2:$A$" & lngLastRow & "=A" & _
lngRow & ",IF($E$2:$E$" & lngLastRow & "=E" & lngRow & _
",$B$2:$B$" & lngLastRow & ")))")

End If
Next
End Sub

 

[puiuluipui]

Perfect!
Thanks allot Jacob!

"Jacob Skaria" a scris: