Help w/ Excel Macro

Sample data is located on the "From This" worksheet.  I want a macro that I run that creates a new sheet and does the following:

What I need created is similar to what a pivot table can do but I need a macro to perform this function.

The unique columns are going to be the emp# and projNo where I need to sum all the "Actual Hours Worked" for each projNo and emp#.

The edge case is then the projNo is 111-001 for a person.  111-001 projNo have five different places to put hours, Columns G - K.  Those need to be summed and put in their respective columns.

"Do This" worksheet is the sample output.
example.xlsx
michaelblitzAsked:
Who is Participating?
 
byundtCommented:
I decided to make a temporary PivotTable, then copy the values over to a new worksheet to produce the desired report. The order of rows for Project 111-001 is in the order of the hours reported in the various columns--only one type of hours are reported per row, but the rows are in a different order than you showed in your desired output.
Sub Reporter()
Application.ScreenUpdating = False
TableIt
MakePT
MakeReport
End Sub

Private Sub TableIt()
Dim lst As ListObject
With ActiveSheet
    If .ListObjects.Count = 0 Then
        Set lst = .ListObjects.Add(SourceType:=xlSrcRange, Source:=.Range("A3").CurrentRegion, xllistobjecthasheaders:=xlYes)
        lst.Name = "tbData"
    End If
End With
End Sub

Private Sub MakePT()
Sheets.Add After:=ActiveSheet
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="tbData").CreatePivotTable _
    TableDestination:=ActiveSheet.Name & "!R3C1", TableName:="PivotTable1"
With ActiveSheet.PivotTables("PivotTable1")
    With .PivotFields("projNo")
        .Orientation = xlRowField
        .Position = 1
    End With
    With .PivotFields("emp#")
        .Orientation = xlRowField
        .Position = 2
    End With
    With .PivotFields("Project Name")
        .Orientation = xlRowField
        .Position = 3
    End With
    With .PivotFields("Employee Name")
        .Orientation = xlRowField
        .Position = 4
    End With
    With .PivotFields("Rate")
        .Orientation = xlRowField
        .Position = 5
    End With
    .AddDataField .PivotFields("Actual Hours Worked"), "Sum of Actual Hours Worked", xlSum
    .AddDataField .PivotFields("Vac"), "Sum of Vac", xlSum
    .AddDataField .PivotFields("Sick"), "Sum of Sick", xlSum
    .AddDataField .PivotFields("Hol"), "Sum of Hol", xlSum
    .AddDataField .PivotFields("Personal Day"), "Sum of Personal Day", xlSum
    
    .ColumnGrand = False
    .RowGrand = False
    With .PivotFields("projNo")
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    With .PivotFields("emp#")
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    With .PivotFields("Project Name")
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    End With
    With .PivotFields("Employee Name")
        .LayoutForm = xlTabular
        .RepeatLabels = True
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    End With
End With
End Sub

Private Sub MakeReport()
Dim pt As PivotTable
Dim cel As Range, rg As Range
Dim i As Long, j As Long, k As Long, n As Long, nVals As Long
Set pt = ActiveSheet.PivotTables(1)
Sheets.Add After:=ActiveSheet
With ActiveSheet
    pt.TableRange1.Copy
    .Range("A1").PasteSpecial Paste:=xlPasteValues
    .Rows(1).Delete
    Application.DisplayAlerts = False
    pt.TableRange1.Worksheet.Delete
    Application.DisplayAlerts = True
    .Range("A1:B1").EntireColumn.Insert
    .Range("E:F").Cut .Range("A:B")
    .Range("E:F").Delete
    .Range("A1:J1").Value = _
        Array("Project Name", "Employee Name", "Proj Number", "emp#", "Rate", "Actual Hours Worked", "Vac", "Sick", "Hol", "Personal Day")
    .Range("A1:J1").Columns.AutoFit
    .Columns(1).ColumnWidth = 15.86
    .Columns(4).ColumnWidth = 14.43
    Set rg = .Cells(2, "A")
    Set rg = Range(rg, .Cells(.Rows.Count, rg.Column).End(xlUp))
    rg.EntireRow.Sort rg.Cells(1, 1), xlAscending
    n = rg.Rows.Count
    For i = n To 1 Step -1
        nVals = Application.CountIf(rg.Cells(i, 6).Resize(1, 5), ">0")
        If nVals > 1 Then
            rg.Cells(i + 1, 1).EntireRow.Resize(nVals).Insert
            rg.Cells(i + 1, 1).Resize(nVals, 5).Value = rg.Cells(i, 1).Resize(1, 5).Value
            rg.Cells(i + 1, 6).Resize(nVals, 5).Value = Array(0, 0, 0, 0, 0)
            k = 0
            For j = 1 To 5
                If rg.Cells(i, 5 + j).Value <> 0 Then
                    k = k + 1
                    rg.Cells(i + k, 5 + j).Value = rg.Cells(i, 5 + j).Value
                End If
            Next
            rg.Cells(i, 1).EntireRow.Delete
        End If
    Next
    .Cells(1, 1).Select
End With
End Sub

Open in new window

Brad
0
 
Saqib Husain, SyedEngineerCommented:
Why is project5 repeated on the do this worksheet?
0
 
byundtCommented:
Sure looks to me like a PivotTable would do what you want. Would you like a macro that creates the PivotTable?
0
Cloud Class® Course: Microsoft Office 2010

This course will introduce you to the interfaces and features of Microsoft Office 2010 Word, Excel, PowerPoint, Outlook, and Access. You will learn about the features that are shared between all products in the Office suite, as well as the new features that are product specific.

 
michaelblitzAuthor Commented:
Project 5 is repeated because the hours are in different columns.

Yes it does look like a PivotTable but I cannot use the PivotTable feature in this instance.
0
 
Saqib Husain, SyedEngineerCommented:
Can you not have all the project 5 on one line and different columns instead of separate lines? This way programming would be easier as well as deterministic and, I believe, would be more presentable.
0
 
michaelblitzAuthor Commented:
No I cannot.  Project Code 111-001 is the only possible project that will have this scenario so you could just base it off that.

Also, project codes are unique, project names are not.
0
 
michaelblitzAuthor Commented:
Thanks Brad.  Let me take a look
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.