You can get very close to what you want using a pivottable.
Use the userid as the row field.
use the event date as the column field
and drag the event time into the data field twice
use Min for the first field
use max for the second field
But if there is only one entry, then you'll see the same time for min and max.
If that's not acceptable, then you could use a macro.
This assumes that you don't have any data in columns D:whatever that you want to
keep. It inserts a new column D and sorts just columns A
by this field.
So if you have data that must be kept--or the order of the data can't be
disturbed, copy your data (only columns A:C) to a new sheet.
Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim RptWks As Worksheet
Dim iRow As Long
Dim iCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim LastCol As Long
Dim WhichEntry As Long
Dim HowManyEntries As Long
Dim WhichRow As Variant 'could be an error
Dim WhichCol As Variant 'could be an error
Set CurWks = Worksheets("Sheet1") '<-- change then name here
Set RptWks = Worksheets.Add
With CurWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range(.Cells(FirstRow, "D"), .Cells(LastRow, "D")).FormulaR1C1 _
= "=rc[-3]&""...""&rc[-2]"
.Range("d1").Value = "Combined"
With .Range("a:d")
.Sort _
key1:=.Columns(1), order1:=xlAscending, _
key2:=.Columns(2), order2:=xlAscending, _
key3:=.Columns(3), order3:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With
.Range("A1:A" & LastRow).AdvancedFilter _
action:=xlFilterCopy, criteriarange:="", _
copytorange:=RptWks.Range("A1"), _
unique:=True
.Range("b1:b" & LastRow).AdvancedFilter _
action:=xlFilterCopy, criteriarange:="", _
copytorange:=RptWks.Range("b1"), _
unique:=True
With RptWks
.Range("b2", .Cells(.Rows.Count, "B").End(xlUp)).Copy
.Range("c1").PasteSpecial Transpose:=True
.Range("b1").EntireColumn.Delete
For iCol = .Cells(1, .Columns.Count) _
.End(xlToLeft).Column To 3 Step -1
.Columns(iCol).Insert
Next iCol
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
.Rows(2).Insert 'for min/max labels
For iCol = 2 To LastCol Step 2
.Cells(2, iCol).Value = "Min Swipe"
.Cells(2, iCol + 1).Value = "Max Swipe"
.Cells(1, iCol + 1).Value = .Cells(1, iCol).Value
Next iCol
End With
For iRow = FirstRow To LastRow
If .Cells(iRow, "D").Value = .Cells(iRow - 1, "D").Value Then
'same group
WhichEntry = WhichEntry + 1
Else
WhichEntry = 1 'first of a new group
HowManyEntries _
= Application.CountIf(.Range("D:d"), .Cells(iRow, "D").Value)
End If
If WhichEntry = 1 Then
'first row in group
WhichRow = Application.Match(.Cells(iRow, "A").Value, _
RptWks.Columns(1), 0)
WhichCol = Application.Match(CLng(.Cells(iRow, "B").Value), _
RptWks.Rows(1), 0)
If IsError(WhichRow) _
Or IsError(WhichCol) Then
MsgBox "Error with: " & iRow & "!!" & vbLf & "quitting!"
Exit Sub
End If
RptWks.Cells(WhichRow, WhichCol).Value = .Cells(iRow, "C").Value
Else
If HowManyEntries > 1 Then
If WhichEntry = HowManyEntries Then
'last entry in the group
'do the max
RptWks.Cells(WhichRow, WhichCol + 1).Value _
= .Cells(iRow, "C").Value
End If
End If
End If
Next iRow
.Columns(4).Delete
End With
With RptWks
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range("B3", .Cells(LastRow, LastCol)).NumberFormat = "hh:mm:ss"
.UsedRange.Columns.AutoFit
End With
End Sub
If you're new to macros:
Debra Dalgleish has some notes how to implement macros here:
http://www.contextures.com/xlvba01.html
David McRitchie has an intro to macros:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
Ron de Bruin's intro to macros:
http://www.rondebruin.nl/code.htm
(General, Regular and Standard modules all describe the same thing.)
