I use the procedure below to look for change of values in Column B then
at that change print out a range as shown. This works fine but it is not
ideal. The values down column B ideally should be one value followed by
some variable blanks before a new value appears in Column B and then I
would want to print out the range up to that point but not including the
new value. This would in turn be followed by some blanks before a new
value again appears and so on. The point that printing would need to
stop would be another challenge as the last value would appear and of
course it would be all blanks after that. It would be allowable to print
that one with up to four rows below it before stopping the procedure. It
is not possible to just print each value plus say five blanks as the
number of blanks after each value is variable. This may not be feasible
but I would value any guidance. Sorry if this is not explained very well.

Dim cell As Range
Dim l count As Long
Dim rCol As Range

'Get the last cell in column A
With Sheets("Field Records")
Set rCol = .Range("B10", .Range("B" & .Rows.Count).End(xlUp))
End With

'Loop through column B
For Each cell In rCol.Cells
'If a new value
If cell.Value < cell.Offset(-1, 0).Value Then
'Count the number of similar values in col B
lCount = Application.CountIf(rCol, cell.Value)
'Resize a range and print it out
cell.Resize(lCount, 16).PrintOut
End If
Next cell

Kind regards
Graham Haughs
Turriff, Scotland

Assume column C can be used to determine the extent of printing (the last
line to be printed will contain a value in column C).

Sub ABC()
Dim rng as Range, rng1 as Range, rng2 as Range
Dim i as Long
set rng = Cells(rows.count,3).End(xlup).offset(1,-1)
rng.Value = "End"

set rng1 = Range("B10",rng).SpecialCells(xlConstants)
for i = 1 to rng1.areas.count - 1
set rng2 = range(rng1(i),rng1(i+1)(0))
rng2.Resize(,16).Printout
Next
rng.ClearContents
End Sub

Assumes there will be blank cells in each range to be printed and that the
start (top left Cell) of the print area contains a constant (not a formula
and not blank).

--
Regards,
Tom Ogilvy





"Graham Haughs" wrote in message
...
I use the procedure below to look for change of values in Column B then at
that change print out a range as shown. This works fine but it is not
ideal. The values down column B ideally should be one value followed by
some variable blanks before a new value appears in Column B and then I
would want to print out the range up to that point but not including the
new value. This would in turn be followed by some blanks before a new value
again appears and so on. The point that printing would need to stop would
be another challenge as the last value would appear and of course it would
be all blanks after that. It would be allowable to print that one with up
to four rows below it before stopping the procedure. It is not possible to
just print each value plus say five blanks as the number of blanks after
each value is variable. This may not be feasible but I would value any
guidance. Sorry if this is not explained very well.

Dim cell As Range
Dim l count As Long
Dim rCol As Range

'Get the last cell in column A
With Sheets("Field Records")
Set rCol = .Range("B10", .Range("B" & .Rows.Count).End(xlUp))
End With

'Loop through column B
For Each cell In rCol.Cells
'If a new value
If cell.Value < cell.Offset(-1, 0).Value Then
'Count the number of similar values in col B
lCount = Application.CountIf(rCol, cell.Value)
'Resize a range and print it out
cell.Resize(lCount, 16).PrintOut
End If
Next cell

Kind regards
Graham Haughs
Turriff, Scotland

Thanks for that Tom. I can see how it works but I know would never have
got there without your help. Many thanks.

Graham

Tom Ogilvy wrote:
Assume column C can be used to determine the extent of printing (the last
line to be printed will contain a value in column C).

Sub ABC()
Dim rng as Range, rng1 as Range, rng2 as Range
Dim i as Long
set rng = Cells(rows.count,3).End(xlup).offset(1,-1)
rng.Value = "End"

set rng1 = Range("B10",rng).SpecialCells(xlConstants)
for i = 1 to rng1.areas.count - 1
set rng2 = range(rng1(i),rng1(i+1)(0))
rng2.Resize(,16).Printout
Next
rng.ClearContents
End Sub

Assumes there will be blank cells in each range to be printed and that the
start (top left Cell) of the print area contains a constant (not a formula
and not blank).

Sorry to come back Tom but I spoke too soon. When I ran it through a
print with several entries it printed one row with the entry in the top
left corner but with no blanks beneath it and then printed two further
pages with a blank row in each. The range that I started it to print had
a value in C10 and B10 and two blank values in C11, C12 and B11, B12. It
should have printed these two rows w ith row 10. There were values in
C13 and B13 but it didn't pick these up and there was no further
printing.I have tried a few variations on your code and will persist but
no success so far. Sorry to be a pain.

Graham

Graham Haughs wrote:
Thanks for that Tom. I can see how it works but I know would never have
got there without your help. Many thanks.

Graham

Tom Ogilvy wrote:
Assume column C can be used to determine the extent of printing (the
last line to be printed will contain a value in column C).

Sub ABC()
Dim rng as Range, rng1 as Range, rng2 as Range
Dim i as Long
set rng = Cells(rows.count,3).End(xlup).offset(1,-1)
rng.Value = "End"

set rng1 = Range("B10",rng).SpecialCells(xlConstants)
for i = 1 to rng1.areas.count - 1
set rng2 = range(rng1(i),rng1(i+1)(0))
rng2.Resize(,16).Printout
Next
rng.ClearContents
End Sub

Assumes there will be blank cells in each range to be printed and that
the start (top left Cell) of the print area contains a constant (not a
formula and not blank).

There was an omisison of Areas in setting up the print area.

Sub ABC()
Dim rng As Range, rng1 As Range, rng2 As Range
Dim i As Long
Set rng = Cells(Rows.Count, 3).End(xlUp).Offset(1, -1)
rng.Value = "End"

Set rng1 = Range("B10", rng).SpecialCells(xlConstants)
For i = 1 To rng1.Areas.Count - 1
Set rng2 = Range(rng1.Areas(i), rng1.Areas(i + 1)(0)) '<== changed line
rng2.Resize(, 16).PrintOut
Next
rng.ClearContents
End Sub

In your example, this would only print Range(B10:B12).Resize(,16)

Showing columns B and C I was assuming you data had a structure like:


BA CA0
CA1
CA2
BB CB0
CB1
CB2

for the above data the code produces:

$B$10:$Q$12
$B$13:$Q$15

as the printouts

I need one column to determine the extent of the data to be printed for the
last entry in column B.


It doesn't have to be column C. Just adjust the code to look at the column
that can be used. Something must indicate that there are additional lines
for the last entry.

If you have data like

BA CA0
CA1
CA2
BB CB0
BC CC0
CC1
CC2

then this method won't work. But I understood you to say every section was
a header with blank rows (from a column B perspective).






--
Regards,
Tom Ogilvy



"Graham Haughs" wrote in message
...
Sorry to come back Tom but I spoke too soon. When I ran it through a print
with several entries it printed one row with the entry in the top left
corner but with no blanks beneath it and then printed two further pages
with a blank row in each. The range that I started it to print had a value
in C10 and B10 and two blank values in C11, C12 and B11, B12. It should
have printed these two rows w ith row 10. There were values in C13 and B13
but it didn't pick these up and there was no further printing.I have tried
a few variations on your code and will persist but no success so far.
Sorry to be a pain.

Graham

Graham Haughs wrote:
Thanks for that Tom. I can see how it works but I know would never have
got there without your help. Many thanks.

Graham

Tom Ogilvy wrote:
Assume column C can be used to determine the extent of printing (the
last line to be printed will contain a value in column C).

Sub ABC()
Dim rng as Range, rng1 as Range, rng2 as Range
Dim i as Long
set rng = Cells(rows.count,3).End(xlup).offset(1,-1)
rng.Value = "End"

set rng1 = Range("B10",rng).SpecialCells(xlConstants)
for i = 1 to rng1.areas.count - 1
set rng2 = range(rng1(i),rng1(i+1)(0))
rng2.Resize(,16).Printout
Next
rng.ClearContents
End Sub

Assumes there will be blank cells in each range to be printed and that
the start (top left Cell) of the print area contains a constant (not a
formula and not blank).

Thanks again Tom. Part of the problem has been that some of the columns, ie
B & C had data validation and formulae respectively which was creating havoc
with End(xlUp). Column G was actually the first "clean" column, and is one
which will hold data in every row, hence giving the indication for the
extent of data for the last entry in column B.
Your interpretation that every section was a header with blank rows was
correct from the viewpoint of these columns. Thanks for the time and effort
which you have put into this.

Graham

"Tom Ogilvy" wrote in message
...
There was an omisison of Areas in setting up the print area.

Sub ABC()
Dim rng As Range, rng1 As Range, rng2 As Range
Dim i As Long
Set rng = Cells(Rows.Count, 3).End(xlUp).Offset(1, -1)
rng.Value = "End"

Set rng1 = Range("B10", rng).SpecialCells(xlConstants)
For i = 1 To rng1.Areas.Count - 1
Set rng2 = Range(rng1.Areas(i), rng1.Areas(i + 1)(0)) '<== changed line
rng2.Resize(, 16).PrintOut
Next
rng.ClearContents
End Sub

In your example, this would only print Range(B10:B12).Resize(,16)

Showing columns B and C I was assuming you data had a structure like:


BA CA0
CA1
CA2
BB CB0
CB1
CB2

for the above data the code produces:

$B$10:$Q$12
$B$13:$Q$15

as the printouts

I need one column to determine the extent of the data to be printed for
the
last entry in column B.


It doesn't have to be column C. Just adjust the code to look at the
column
that can be used. Something must indicate that there are additional
lines
for the last entry.

If you have data like

BA CA0
CA1
CA2
BB CB0
BC CC0
CC1
CC2

then this method won't work. But I understood you to say every section
was
a header with blank rows (from a column B perspective).






--
Regards,
Tom Ogilvy



"Graham Haughs" wrote in message
...
Sorry to come back Tom but I spoke too soon. When I ran it through a
print
with several entries it printed one row with the entry in the top left
corner but with no blanks beneath it and then printed two further pages
with a blank row in each. The range that I started it to print had a
value
in C10 and B10 and two blank values in C11, C12 and B11, B12. It should
have printed these two rows w ith row 10. There were values in C13 and
B13
but it didn't pick these up and there was no further printing.I have
tried
a few variations on your code and will persist but no success so far.
Sorry to be a pain.

Graham

Graham Haughs wrote:
Thanks for that Tom. I can see how it works but I know would never
have
got there without your help. Many thanks.

Graham

Tom Ogilvy wrote:
Assume column C can be used to determine the extent of printing (the
last line to be printed will contain a value in column C).

Sub ABC()
Dim rng as Range, rng1 as Range, rng2 as Range
Dim i as Long
set rng = Cells(rows.count,3).End(xlup).offset(1,-1)
rng.Value = "End"

set rng1 = Range("B10",rng).SpecialCells(xlConstants)
for i = 1 to rng1.areas.count - 1
set rng2 = range(rng1(i),rng1(i+1)(0))
rng2.Resize(,16).Printout
Next
rng.ClearContents
End Sub

Assumes there will be blank cells in each range to be printed and that
the start (top left Cell) of the print area contains a constant (not a
formula and not blank).