Create a report with monthly usage columns

[John]

I would like to create a report by combining individual monthly usage
information onto a master page that has columns for each month.
Individual part numbers for any given month would have to match a part
number on the master page, offset to the appropriate month column and
paste the usage amount.


Master page Jan page (Usage Information)
Column1 Column 2 Col 3 Col 4 Column 1 Column 2 Col 3

Usage Usage
Part number Description Jan Feb Part number Description Jan

124 16x7 door 124 16x7 door 10
125 Track 126 Spring 20
126 Spring
127 Hinge
128 Hardware

The following is the desired results from the example above:

Master page
Usage
Part number Description Jan Feb

124 16x7 door 10
125 Track
126 Spring 20
127 Hinge
128 Hardware

The first part number on each page starts at row "a8" and there are
3000 records on the master page. Individual monthly pages have about
200 individual records.

I can setup 12 macro buttons (one for each month) to run the code for
the individual month and offsetting the information to the correct
column. You may ask why I don't ask the IT department at the company
where I work. Everyone knows that IT people are not sitting around
looking for projects such as this plus they never see any value in
this type of report. If you have dealt with IT people before you know
that it takes 12 months of arguing before starting the project and
then the finished product is downsized to where it is not usable. I am
begging for anyone's help in providing code (even if you work within
the IT industry) to make this work.

Thanks in advance for your help.

 

[Tom Ogilvy]

Sub BuildReport()
Dim i As Long, sh As Worksheet
Dim sName As String
Dim cell As Range, rng As Range
Dim rng1 As Range, res As Variant
For i = 1 To 12
sName = Format(DateSerial(Year(Date), i, 1), "mmm")
Set sh = Worksheets(sName)
Set rng = sh.Range(sh.Cells(8, 1), _
sh.Cells(Rows.Count, 1).End(xlUp))
For Each cell In rng
With Worksheets("Master")
Set rng1 = .Range(.Cells(8, 1), _
.Cells(Rows.Count, 1).End(xlUp))
res = Application.Match(cell.Value, rng1, 0)
If Not res Is Nothing Then
.Cells(res + 7, i + 2).Value = cell.Offset(0, 2).Value
End If
End With
Next cell
Next i
End Sub


Code is untested and may contain typos.