Summarizing data from 21 worksheet to a one sheet with VBA.

[Geranimo]

Excel 2010 with MS Vista
I have data in 21 sheets (workpackages) and i want to summarise to one sheet tab with VBA.
Details:
21 Sheet named as WP-1,WP-2...,WP-21 will be summarised at Summary Tab.
In each sheet (Rate) F29 to AW 29 has got hourly rates
and (EmpName) F28 to AW 28 has employee names.
and (TaskName) A30 to A499 has got task name.
Employee and task name can be repeated in one sheet or other sheets (workpackages)

I want to be able to list task name on the rows and employee name on the column, as a result summarise the numbers in the table, like a pivot table. (I tried pivot table looking at a summary table does not work)

I have tried to create a table with array formulas and used few codes(I am beginner) but can not get it working.(Array formulas collapses the file)

I want to say:
On any workbook with name starting with 'WP-"
Look at F28-AW28 and list the empname only once (to Summary Sheet B2 to Z2),(dont double up)
Look at A30 to A499 and list the taskname only once without repeating (to Summary Sheet A3 to A10000.
Then whatever the hours for each person on the task multiply it by hourly rate respective in row F29 to AW29. summarise in Summary .

Maybe I am asking for too much, but help or ideas would be appreciated.

Or if you have something similar I can have look at your logic.

Thanks all,

 

[trunten]

Hi Geranimo,

It should be fairly straight forward could you upload an example workbook?

 

[Geranimo]

Thanks Trunten,

I have tried uploading but did not work as I am new member.

Anyhow each worksheet (21 sheet) is like below with 500 row and 45 column.
I can e-mail to you.

Thanks a lot,

Emp Id 121 130 130 150 131 130 170

Bid Rate 97 97 97 97 122 122 122

WBS Hours
2 PRI 1
PRI 2 2
2.1.1 PRI 3 3
2.1.2 PRI 2
2.1.3 PRI
2.1.3.1 PRI
2.1.3.2 PRI 2 4
2.1.3.3 PRI

 

[Trevor G]

You can copy and paste part of your spreadsheet or you can use Excel Jeannie to convert your spreadhseet into HTML code to allow others to see what you are working with, including formula.

Here is a link to download it

http://www.excel-jeanie-html.de/html/down_en.php

 

[Geranimo]

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
2	Project WBS	Discipline	Deliverable / Activity			Labour Resource
3					Emp Id	121	130	130	150	131	130	170	150	190
4					Grade
5					Bid Rate	97	97	97	97	122	122	122	231	122	122	122	122	148	148	170	194	231
6																		Hours
7	2	PRI				1
8		PRI				2	2
9	2.1.1	PRI						3		3
10	2.1.2	PRI				2
11	2.1.3	PRI
12	2.1.3.1	PRI
13	2.1.3.2	PRI						2		4
14	2.1.3.3	PRI
15	2.1.3.4	PRI
wp-1

Excel Workbook
	A	B	C	D	E	F	G
2	All 21 worksheets will be summarised here without repeating the employee ids and task number or text.
3
4	WBS	121	130	131	150	170	190
5	Unspecified
6	2.1
7	2.1.1
8	2.1.2
9	2.1.3
10	2.1.3.1		SUMMARY
11	2.1.3.2			"emp hour*hourly rate*contingency
12	2.1.3.3
summary

 

[Geranimo]

Managed to upload finally,

Overall i am trying to summarise 21 wp (top part) to a table (like bottom part.) with VBA.

Thanks a lot,

 

[trunten]

Hi, sorry to do this to you, but I'm off on holiday in the next hour (really)
It turns out it was a bit more complex that i thought.
i've started, if you can wait two weeks i'll finish
sorry.

Sub summarise()
    Dim empIdRow As Long, gradeRow As Long, rateRow As Long
    Dim projectCol As Integer, sheetCounter As Integer
    Dim employees As Collection, projects As Collection
    Dim colCount As Long, rowCount As Long, i As Long
    Dim tmp As Variant
    Dim unique As Boolean
    Dim summarySheet As Worksheet

    empIdRow = 2 'The row number containing your employee ID's
    gradeRow = 3 'The row number containing your grades
    rateRow = 4 'The row number containing your bid rates
    projectCol = 1 'Column number of your project codes
    Set employees = New Collection
    Set projects = New Collection
       
    For sheetCounter = 1 To 21 'the number of sheets
        With Sheets("WP-" & sheetCounter)
            .Select
            For colCount = 1 To .UsedRange.Columns.Count
                unique = True
                tmp = .Cells(empIdRow, colCount)
                If tmp <> "" And tmp <> "Emp Id" Then
                    For Each Item In employees
                        If Item = tmp Then unique = False
                    Next Item
                    If unique Then employees.Add tmp
                End If
                tmp = ""
            Next colCount
            For rowCount = 1 To .UsedRange.Rows.Count
                unique = True
                tmp = .Cells(rowCount, projectCol)
                If tmp <> "" And tmp <> "Project WBS" Then
                    For Each Item In projects
                        If Item = tmp Then unique = False
                    Next Item
                    If unique Then projects.Add tmp
                End If
                tmp = ""
            Next rowCount
        End With
    Next sheetCounter
    On Error Resume Next
    Set summarySheet = Sheets("Summary")
    If summarySheet Is Nothing Then
        Set summarySheet = Sheets.Add
        summarySheet.Name = "Summary"
    End If
    On Error GoTo 0
    With summarySheet
        .UsedRange.ClearContents
        .Select
        For i = 2 To employees.Count
            .Cells(1, i) = employees.Item(i - 1)
        Next i
        For i = 2 To projects.Count
            .Cells(i, 1) = projects.Item(i - 1)
        Next i
    End With
End Sub

 

[trunten]

Free wifi!
Hi Geranimo I'm having to write this on my phone with no chance of testing. Hopefully it works for you.

Sub summarise()
**Dim empIdRow as long, gradeRow as Long, rateRow as Long
**Dim projectCol as Integer, sheetCounter as Integer
**Dim employees as Collection, projects as Collection
**Dim colCount as Long, rowCount as Long, i as Long
**Dim tmp as Variant
**Dim c1 as Range, c2 as Range
**Dim idRange as Range, projectRange as Range
**Dim unique as Boolean
**Dim summarySheet as Worksheet

**empIdRow = 2
**gradeRow = 3
**rateRow = 4
**projectCol = 1
**Set employees = New Collection
**Set projects = New Collection

**For sheetCounter = 1 To 21
*****With Sheets("WP-" & sheetCounter)
********.Select
********For colCount = 1 To .UsedRange.Columns.Count
***********unique = True
***********tmp = .Cells(empIdRow, colCount)
***********If tmp <> "" And tmp <> "Emp Id" Then
**************For Each Item In employees
*****************If Item = tmp Then*
********************unique = False
********************Exit For
*****************End If
**************Next Item
**************If unique Then employees.Add tmp
***********End If
***********tmp = ""
********Next colCount
********For rowCount = 1 To .UsedRange.Rows.Count
***********unique = True
***********tmp = .Cells(rowCount, projectCol)
***********If tmp <> "" And tmp <> "Project WBS" Then
**************For Each Item In projects
*****************If Item = tmp Then
********************unique = False
********************Exit For
*****************End If
**************Next Item
**************If unique Then projects.Add tmp
***********End If
***********tmp = ""
********Next rowCount
*****End With
**Next sheetCounter
**On Error Resume Next
**Set summarySheet = Sheets("Summary")
**If summarySheet Is Nothing Then
*****Set summarySheet = Sheets.Add
*****summarySheet.Name = "Summary"
**End If
**On Error GoTo 0
**With summarySheet
*****.UsedRange.ClearContents
*****.Select
*****For colCount = 2 To employees.Count
********.Cells(1, colCount) = employees.Item(colCount - 1)
*****Next colCount
*****For rowCount = 2 To projects.Count
********.Cells(rowCount, 1) = projects.Item(rowCount - 1)
*****Next rowCount
**End With
**Set idRange = Range(Cells(1, 2), Cells(1, employees.Count))
**Set projectRange = Range(Cells(2, 1), Cells(projects.Count, 1))
**For Each c1 In idRange
*****For sheetCount = 1 To 21
********With Sheets("WP-" & sheetCount)
***********For colCount = 1 To .UsedRange.Columns.Count
**************If Cells(empIdRow, colCount) = c1.Value Then
*****************For Each c2 In projectRange
********************For rowCount = 1 to .UsedRange.Rows.Count
***********************If Cells(rowCount, projectCol) = c2.Value Then
**************************summarySheet.Cells(c2.Row, c1.Col) = _
*****************************summarySheet.Cells(c2.Row, c1.Col + _
*****************************(.Cells(rowCount, colCount) * _
******************************.Cells(rateRow, colCount)
***********************End If
********************Next rowCount
*****************Next c2
**************End If
***********Next colCount
********End With
*****Next sheetCount
**Next c1
End Sub

 

[trunten]

P.s I have no idea where those stars came from. You'll have to do a find and replace with a space character

 

[Geranimo]

Thanks a lot mate, I did not have time to go back to the project. I want to try your code in next couple of days. Once I go back to my desk. I will update you. Enjoy your break. Thanks a lot. Geranimo