Formatting Using VBA

User Task Total Time 
A Checking Mails 3:00:01 
C Checking Mails 1:00:00 
D Checking Mails 0:00:01 
E Checking Mails 0:00:05 
A Idle 1:30:30 
B Idle 1:30:30 
B Music 4:00:46 
D Music 1:00:55 
E Music 0:35:35 

Sub ConsolidateAndGroup() 
Dim sMasterSheet As String 
Dim sResultSheet As String 
Dim lMasterFirstUsedRow As Long 

Dim GroupOn As Variant 
Dim SummarizeOn As Variant 

Dim iBasedOnColumn As Integer 
Dim iUserColumn As Integer 
Dim iAddColumn As Integer 

    sMasterSheet = "Sheet1" 
     
    lMasterFirstUsedRow = 1 
    iBasedOnColumn = 2 
    iUserColumn = 1 
    iAddColumn = 3 
     
    sResultSheet = "Result" 

    GroupOn = Array(iBasedOnColumn, iUserColumn) 
    SummarizeOn = Array(iAddColumn) 
     
    Call CopySheet(sMasterSheet, sResultSheet, lMasterFirstUsedRow) 
     
    Call ConsolidateData(sResultSheet, GroupOn, SummarizeOn) 
     
     
End Sub 


Sub CopySheet(sMasterSheet As String, sResultSheet As String, Optional lMasterFirstUsedRow As Long = 1) 
Dim lMaxRows As Long 
Dim iMaxCols As Integer 

    Sheets(sMasterSheet).Select 
    lMaxRows = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    iMaxCols = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
     
    On Error Resume Next 
        Sheets(sResultSheet).Delete 
    On Error GoTo 0 

    Sheets.Add 
    ActiveSheet.Name = sResultSheet 

    Sheets(sMasterSheet).Select 
    Range(Cells(lMasterFirstUsedRow, 1), Cells(lMaxRows, iMaxCols)).Copy 
     
    Sheets(sResultSheet).Select 
    Range("A1").Select 
    Selection.PasteSpecial 

End Sub 

Sub ConsolidateData(sTargetSheet As String, GroupOn As Variant, SummarizeOn As Variant, Optional lMasterFirstRow As Long = 1) 
Dim GroupOnItem As Variant 
Dim bScreenUpdating As Boolean 
Dim sActiveSheet As String 
Dim lMaxRows As Long 
Dim lThisRow As Long 
Dim bConsolidate As Boolean 

    sActiveSheet = ActiveSheet.Name 
    bScreenUpdating = Application.ScreenUpdating 
     
    Application.ScreenUpdating = False 
    Sheets(sTargetSheet).Select 
    ActiveSheet.AutoFilterMode = False 
     
    lMaxRows = 0 
    On Error Resume Next 
    lMaxRows = Sheets(sTargetSheet).Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    On Error GoTo 0 
     
    If lMaxRows <= lMasterFirstRow Then 
        MsgBox "Unexpectedly no data as found" 
        GoTo Exit_Sub 
    End If 
     
    For GroupOnItem = UBound(GroupOn) + 1 To 1 Step -3 
         
        Range(Cells(lMasterFirstRow, 1), Cells(Rows.Count, Columns.Count)).Select 
         
        If (GroupOnItem - 3 >= 0) Then 
            Selection.Sort _ 
                            Key1:=Cells(lMasterFirstRow + 1, GroupOn(GroupOnItem - 3)), Order1:=xlAscending, _ 
                            Key2:=Cells(lMasterFirstRow + 1, GroupOn(GroupOnItem - 2)), Order2:=xlAscending, _ 
                            Key3:=Cells(lMasterFirstRow + 1, GroupOn(GroupOnItem - 1)), Order3:=xlAscending, _ 
                            Header:=xlYes, OrderCustom:=1, _ 
                            MatchCase:=False, Orientation:=xlTopToBottom 
         
        ElseIf (GroupOnItem - 2 >= 0) Then 
            Selection.Sort _ 
                            Key1:=Cells(lMasterFirstRow + 1, GroupOn(GroupOnItem - 2)), Order1:=xlAscending, _ 
                            Key2:=Cells(lMasterFirstRow + 1, GroupOn(GroupOnItem - 1)), Order2:=xlAscending, _ 
                            Header:=xlYes, OrderCustom:=1, _ 
                            MatchCase:=False, Orientation:=xlTopToBottom 
        Else 
            Selection.Sort _ 
                            Key1:=Cells(lMasterFirstRow + 1, GroupOn(GroupOnItem - 1)), Order1:=xlAscending, _ 
                            Header:=xlYes, OrderCustom:=1, _ 
                            MatchCase:=False, Orientation:=xlTopToBottom 
        End If 
         
         
    Next 
         
    lThisRow = lMasterFirstRow + 1 
    Do While (lThisRow <= lMaxRows) 
     
        bConsolidate = True 
        For GroupOnItem = 0 To UBound(GroupOn) 
         
            If Cells(lThisRow, GroupOn(GroupOnItem)) <> Cells(lThisRow + 1, GroupOn(GroupOnItem)) Then 
                bConsolidate = False 
                Exit For 
            End If 
             
        Next 
     
        If (bConsolidate) Then 
            For GroupOnItem = 0 To UBound(SummarizeOn) 
             
                Cells(lThisRow, SummarizeOn(GroupOnItem)) = Cells(lThisRow, SummarizeOn(GroupOnItem)) + Cells(lThisRow + 1, SummarizeOn(GroupOnItem)) 
                 
            Next 
             
            Rows(lThisRow + 1).Delete 
            lMaxRows = lMaxRows - 1 
             
        Else 
             
            lThisRow = lThisRow + 1 
         
        End If 
     
    Loop 
     
Exit_Sub: 
     
    Sheets(sActiveSheet).Select 
    Application.ScreenUpdating = bScreenUpdating 
     
End Sub