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?

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?

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?

By the way, the "Data" worksheet has one row containing column titles.

"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?

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?

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?

assume the number of copies are to the right of the company name in the list
sheet (in column B)

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 copies:=cell.offset(0,1)
End if
Next
End With
End sub

--
Regards,
Tom Ogilvy



"Freddy" wrote in message
...
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?

that why

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



starts in row 2.

--
Regards,
Tom Ogilvy


"Freddy" wrote in message
...
By the way, the "Data" worksheet has one row containing column titles.

"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?

As expected, your code works great. Would it be possible to change either the
background color of the cells or the text color of the cells that were
printed?

"Tom Ogilvy" wrote:

assume the number of copies are to the right of the company name in the list
sheet (in column B)

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 copies:=cell.offset(0,1)
End if
Next
End With
End sub

--
Regards,
Tom Ogilvy



"Freddy" wrote in message
...
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?

Where do I place your code below?

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



"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?

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")
.Range("A:F").Interior.ColorIndex = xlNone
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
With .range(rtop,rBottom).Resize(,6)
.printout copies:=cell.offset(0,1)
.Interior.ColorIndex = 3
End With
End if
Next
End With
End sub


--
Regards,
Tom Ogilvy

"Freddy" wrote in message
...
As expected, your code works great. Would it be possible to change either
the
background color of the cells or the text color of the cells that were
printed?

"Tom Ogilvy" wrote:

assume the number of copies are to the right of the company name in the
list
sheet (in column B)

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 copies:=cell.offset(0,1)
End if
Next
End With
End sub

--
Regards,
Tom Ogilvy



"Freddy" wrote in message
...
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?

In the same module as the other code.

--
Regards,
Tom Ogilvy

"Freddy" wrote in message
...
Where do I place your code below?

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



"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?

Where specifically?

"Tom Ogilvy" wrote:

In the same module as the other code.

--
Regards,
Tom Ogilvy

"Freddy" wrote in message
...
Where do I place your code below?

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



"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?

That was as specific as it needs to be. If you meet that condition, it is
in the right place.

--
Regards,
Tom Ogilvy

"Freddy" wrote in message
...
Where specifically?

"Tom Ogilvy" wrote:

In the same module as the other code.

--
Regards,
Tom Ogilvy

"Freddy" wrote in message
...
Where do I place your code below?

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



"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?

It's all good. Until the next challenge...

"Tom Ogilvy" wrote:

That was as specific as it needs to be. If you meet that condition, it is
in the right place.

--
Regards,
Tom Ogilvy

"Freddy" wrote in message
...
Where specifically?

"Tom Ogilvy" wrote:

In the same module as the other code.

--
Regards,
Tom Ogilvy

"Freddy" wrote in message
...
Where do I place your code below?

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



"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?