Solved

Help w/ Excel Macro

Posted on 2013-05-13
9
248 Views
Last Modified: 2014-05-23
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
0
Comment
Question by:michaelblitz
  • 3
  • 2
  • 2
9 Comments
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39163395
Why is project5 repeated on the do this worksheet?
0
 
LVL 81

Expert Comment

by:byundt
ID: 39163413
Sure looks to me like a PivotTable would do what you want. Would you like a macro that creates the PivotTable?
0
 

Author Comment

by:michaelblitz
ID: 39165695
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
Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39165865
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
 

Author Comment

by:michaelblitz
ID: 39165888
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
 
LVL 81

Accepted Solution

by:
byundt earned 500 total points
ID: 39167032
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
 

Author Comment

by:michaelblitz
ID: 39205568
Thanks Brad.  Let me take a look
0

Featured Post

Three Reasons Why Backup is Strategic

Backup is strategic to your business because your data is strategic to your business. Without backup, your business will fail. This white paper explains why it is vital for you to design and immediately execute a backup strategy to protect 100 percent of your data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Lync meeting or Lync conferencing is what many organizations would like to deploy to allow them save money. But companies are now giving up for various reasons, one of which is that they cannot join external meetings (non-federated company meetings)…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question