Formatting Using VBA

 Rajesh -

I am creating a macro based application. I wanted to merge almost 20-25 sheets to one sheets. that task is completed.

After merging Now i have 1 sheet with 7 Columns.

In 1st column i have employee names, 2nd column i have list of task that completed for the day ,in the last column i have total time taken for task to complete for the day and in the 3rd column i have dates.

Now i wanted to define all the task and employee name with total time taken for the entire month in sheet2.

Like, in sheet2

Task Name: Project Management:

Emp Name Total Time Taken

Roy 4:10:25
Lord 8:01:21

Task Name : System Management

Emp Name Total Time Taken
Roy 2:10:03
Lord 1:11:13

Please find the link, here i am uploaded the spread sheet.

Please help me to solve.

1 reply

Registration date
Thursday January 28, 2010
Last seen
August 2, 2020
It is not complete, in the sense of what you need. What this macro will do is to create a new sheet which will have all the added values. like

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 

The main routine is "ConsolidateAndGroup"
Rest are supporting routines

From there, a separate macro can create your final sheet.
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 

    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 
    On Error GoTo 0 

    ActiveSheet.Name = sResultSheet 

    Range(Cells(lMasterFirstUsedRow, 1), Cells(lMaxRows, iMaxCols)).Copy 

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 
    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 
            Selection.Sort _ 
                            Key1:=Cells(lMasterFirstRow + 1, GroupOn(GroupOnItem - 1)), Order1:=xlAscending, _ 
                            Header:=xlYes, OrderCustom:=1, _ 
                            MatchCase:=False, Orientation:=xlTopToBottom 
        End If 
    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 
        If (bConsolidate) Then 
            For GroupOnItem = 0 To UBound(SummarizeOn) 
                Cells(lThisRow, SummarizeOn(GroupOnItem)) = Cells(lThisRow, SummarizeOn(GroupOnItem)) + Cells(lThisRow + 1, SummarizeOn(GroupOnItem)) 
            Rows(lThisRow + 1).Delete 
            lMaxRows = lMaxRows - 1 
            lThisRow = lThisRow + 1 
        End If 
    Application.ScreenUpdating = bScreenUpdating 
End Sub 
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2821 users have said thank you to us this month

Excellent code. This is the out put that i expected.

An also can we leave a row after every group and that row i want the total time taken for that group.

Please help me....