Sub PrintCompanies()
Dim rng as Range, rng1 as Range
Dim cell as Range, rTop as Range
Dim rBottom as Range

with worksheets("List")
set rng = .range(.cells(1,1),.cells(1,1).End(xldown))
End with

with worksheets("Data")
set rng1 = .Range(.Cells(2,1),.Cells(rows.count,1).End(xlup))


for each cell in rng
set rTop = rng1.Find(What:=cell, _
After:=rng1(rng1.count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

set rBottom = rng1.Find(What:=cell, _
After:=rng1(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)

if not rTop is nothing then
' changed 10 columns to 6 columns, also the 1 was a typo
.range(rtop,rBottom).Resize(,6).printout
End if
Next
End With
End sub

if you want to determine the number of columns

public Function NumColumns(rng as Range)
max = 1
for each cell in rng
col = rng.parent.cells(cell.row,"IV").End(xltoLeft).Colu mn
if col max then max = col
Next
NumColumns = col
End Function


then in the code

if not rTop is nothing then
' changed 10 columns to 6 columns:
set rng = .range(rtop,rBottom)
rng.Resize(,NumColumns(rng)).Printout
End if

--
Regards,
Tom Ogilvy

"Freddy" wrote:

I apologize for not initially giving more details. I tested your code and it
essentially does what I need. Here are more details that will assist you in
providing me more specific resolution.

The "Data" spreadsheet contains 6 columns which must included in the
printout (Although it would be nice for the code to determine how many there
are.) The amount of rows for a company can vary from 1 to multiple rows. For
example, company1 may have 1 row, company2 may have 3 rows, etc. Most of the
time there is only one 8.5" x 11.0" printout per company.

"Tom Ogilvy" wrote:

Making assumptions for the myriad of details left out:

Sub PrintCompanies()
Dim rng as Range, rng1 as Range
Dim cell as Range, rTop as Range
Dim rBottom as Range

with worksheets("List")
set rng = .range(.cells(1,1),.cells(1,1).End(xldown))
End with

with worksheets("Data")
set rng1 = .Range(.Cells(2,1),.Cells(rows.count,1).End(xlup))


for each cell in rng
set rTop = rng1.Find(What:=cell, _
After:=rng1(rng1.count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

set rBottom = rng1.Find(What:=cell, _
After:=rng1(1), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)

if not rTop is nothing then
.range(rtop,rBottom).Resize(1,10).printout
End if
Next
End With
End sub

--
Regards,
Tom Ogilvy


"Freddy" wrote:

I would like to write a VBA macro that reads a predetermined list of
companies then searches rows in a spreadsheet then, when a match is found,
whether one row or multiples rows, defines the print area then finally prints
it. The rows in the spreadsheet are already grouped by company name. Any
suggestions?