?
Solved

Help w/ Excel Macro

Posted on 2013-05-13
9
Medium Priority
?
271 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Moving data to the cloud? Find out if you’re ready

Before moving to the cloud, it is important to carefully define your db needs, plan for the migration & understand prod. environment. This wp explains how to define what you need from a cloud provider, plan for the migration & what putting a cloud solution into practice entails.

 
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 2000 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

What Is Blockchain Technology?

Blockchain is a technology that underpins the success of Bitcoin and other digital currencies, but it has uses far beyond finance. Learn how blockchain works and why it is proving disruptive to other areas of IT.

Question has a verified solution.

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

As with any other System Center product, the installation for the Authoring Tool can be quite a pain sometimes. This article serves to help you avoid making these mistakes and hopefully save you a ton of time on troubleshooting :)  Step 1: Make sur…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

777 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