I made a couple of assumptions; first, that the 200 worksheets and the
summary sheet are in the same .xls workbook. Second is that the list of
projects on the summary sheet match the individual project sheet tab names
precisely (spelling and case); and last that the list of job titles on the
summary sheet and those on the project sheets also match precisely.
Start by making a copy of your workbook just in case things go wrong. Open
that copy and press [Alt]+[F11] to open the Visual Basic (VB) Editor. Then
choose Insert --> Module to bring up an empty code module. Copy the code
below and paste it into the code module, and make any edits to the Const
values in it that need to be made to match things up properly (I tried to
match based on your posting, but double check things such as the name of the
Summary sheet). Close the VB editor.
Choose the summary sheet and use Tools --> Macro --> Macros to [Run] the
macro. Should work for you. If any project name or job title name doesn't
match, you'll get a message at the end saying so; or you'll get a message
saying that things went very, very well.
Here's the code:
Sub BuildSummaryPage()
'change these constants as required
'
'about the Summary sheet
Const summaryName = "Summary" ' sheet name
Const rowWithLaborTitles = 1
Const colWithProjNumbers = "A"
'about the individual project sheets
Const JobTitlesCol = "C"
Const HrsWorkedCol = "E"
'next value is first row on the
'project sheets with a job position
'on it. Assumed row 1 has a label.
Const firstDataRow = 2
'end of user definable values
'
Dim summaryWS As Worksheet
Dim listOfPositions As Range
Dim anyPosition As Range
Dim listOfProjects As Range
Dim anyProject As Range
Dim offset2Hours As Integer
Dim projectRow As Long
Dim projectColumn As Long
Dim projectWS As Worksheet
Dim projectName As String ' from sheet tabs
Dim currentTitlesList As Range
Dim anyCurrentTitle As Range
Dim searchResult As Range
Dim errorFlag As Boolean
'set up to look through the Summary sheet
Set summaryWS = ThisWorkbook.Worksheets(summaryName)
Set listOfPositions = summaryWS.Range("B1:CW1")
Set listOfProjects = summaryWS.Range("A1:" & _
summaryWS.Range("A" & Rows.Count).End(xlUp).Address)
offset2Hours = Range(HrsWorkedCol & 1).Column - _
Range(JobTitlesCol & 1).Column
'clear out any previous results within the grid
'from B2 over and down to last used row and column
'borrow currentTitlesList for this operation
Set currentTitlesList = summaryWS.Range("B2:" & _
Cells(summaryWS.UsedRange.Rows.Count, _
summaryWS.UsedRange.Columns.Count).Address)
currentTitlesList.ClearContents
Set currentTitlesList = Nothing
'now we can actually get down to work
For Each projectWS In ThisWorkbook.Worksheets
'skip the summary sheet itself
projectName = projectWS.Name
If projectName <> summaryName Then
'assumed to be a project sheet, process it
'get list of job titles from the sheet
'
'find the project on the Summary sheet
Set searchResult = listOfProjects. _
Find(what:=projectName, LookIn:=xlValues)
If Not searchResult Is Nothing Then
'found the project, save row from Summary sheet
projectRow = searchResult.Row
'get reference to job titles on project sheet
Set currentTitlesList = _
projectWS.Range(JobTitlesCol & firstDataRow & ":" _
& projectWS.Range(JobTitlesCol & Rows.Count). _
End(xlUp).Address)
'get each title for the project in turn and
'match to title in row 1 of the Summary sheet
For Each anyCurrentTitle In currentTitlesList
Set searchResult = listOfPositions. _
Find(what:=anyCurrentTitle, LookIn:=xlValues)
If Not searchResult Is Nothing Then
'found it
'add to any previous hours for same position on
'this same project
summaryWS.Cells(projectRow, searchResult.Column) = _
summaryWS.Cells(projectRow, searchResult.Column) + _
anyCurrentTitle.Offset(0, offset2Hours)
Else
'could report no match on labor title here
errorFlag = True
End If
Next
Else
'could report no match on Project title here
errorFlag = True
End If
End If
Next
'do housekeeping
Set currentTitlesList = Nothing
Set listOfPositions = Nothing
Set listOfProjects = Nothing
Set summaryWS = Nothing
If errorFlag Then
MsgBox "Task completed. But with some 'not found' errors.", _
vbOKOnly + vbCritical, "Task Complete"
Else
MsgBox "Task completed without apparent errors.", _
vbOKOnly + vbInformation, "Task Complete"
End If
End Sub
Al said:
I wish to import numeric data from numerous worksheets, say upto 200, into an
overall summary page.
For example, I have 200 projects, thus each worksheet is named Prj1, Prj2,
etc. In each of these I enter the numbers of hours that the workforce book to
these projects. The list of workforce members can be up to 100 different
designations, and different projects necessarily do not use the same
combination of the workforce. For example:
Column C Column E
Prj1 row 17 lead electrical engineer 200
Row 23 Senior mechanical engineer 450
Row 51 Junior piping engineer 700
Prj2 row 9 lead mechanical engineer 50
Row 33 Senior piping designer 900
Row 94 Draftsman 1100
The overall summary sheet takes the form of a table of projects in column A,
and the workforce in B through to CW (100 different designations) Thus the
data is in a column in the project worksheet, and in a row in the summary
sheet! (I cannot alter this as these are industry practices!)
My objective is to enter numbers into PrjX, and have these pulled into the
summary sheet, and placed into their correct cell!
Hopefully I have adequately explained this, and someone will have some ideas
as to how this can be done!
