Formatting Using VBA

[Closed]
Report
-
 Rajesh -
Hello,

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.

http://www.editgrid.com/user/kiranindia1986/Rajesh_Excel

Please help me to solve.


1 reply

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
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 

    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 
1
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....