I tested your revised code and it works very well. Would you assist me with
another enhancement? I'd like for the code to be able to print more than one
copy, let's say 2, for predetermined companies, not all of them, using, if
possible, the list of companies in the "List" worksheet.

"Tom Ogilvy" wrote:

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?