VBA to insert page breaks at a blank with varying blck size

[Simon B]

Hi
I've written a macro that takes a lot of data and summarises it into blocks of data one page wide, and multiple pages long. Each block of data in the output is always the same length, but depending on where I extract the data from the length may be different in each run through, so depending on this each block may be 5 or 10 or 15 rows, in fact any number. Each block is separated by a blank cell in column B. What I want to do is put a page break in at the blank cell above where the 'natural' page break is, so that the blocks of data are not split over 2 pages. I have tried to write this and had a look on forum sites and have so far been unsuccessful, so any help anyone has would be greatly appreciated.
Thanks
Simon

 

[nuked]

Can you post the part of your code that transposes the data onto the sheet please?

 

[Simon B]

I'm no Excel VBA expert, so the code that does this is very long, and not very pretty to be honest, but it takes data that is pages and pages long and summarises it. Not pretty, but all works, and the code wouldn't make sense without the original txt file that it pulls the data.
This last bit is a separate issue and a stand alone bit of code would hopefully just insert to the end of the macros.
I basically have 6 columns. A is a sample name. B-G are results, but there maybe more than 5 results, so it effectively wraps it underneath. Like below. This is only for 3 samples, and a few elements though, it could be many more samples and elements analysed, hence why I I would like to put a page break in at a blank point that is above the natural page break, not every blank.

[TABLE="width: 469"]
<colgroup><col><col span="5"></colgroup><tbody>[TR]
[TD][/TD]
[TD]Ba2304[/TD]
[TD]Ba2304-2[/TD]
[TD]Ba2335[/TD]
[TD]Ba2335-2[/TD]
[TD]Ba4130[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[/TR]
[TR]
[TD]Wash[/TD]
[TD="align: right"]-0.0268[/TD]
[TD="align: right"]-0.0269[/TD]
[TD="align: right"]-0.0269[/TD]
[TD="align: right"]-0.0265[/TD]
[TD="align: right"]-0.0296[/TD]
[/TR]
[TR]
[TD]B1[/TD]
[TD="align: right"]17.54[/TD]
[TD="align: right"]17.54[/TD]
[TD="align: right"]17.54[/TD]
[TD="align: right"]17.46[/TD]
[TD="align: right"]17.69[/TD]
[/TR]
[TR]
[TD]B2[/TD]
[TD="align: right"]2.019[/TD]
[TD="align: right"]1.979[/TD]
[TD="align: right"]1.995[/TD]
[TD="align: right"]1.986[/TD]
[TD="align: right"]2.022[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Ba4130-2[/TD]
[TD]S_1807[/TD]
[TD]S_1807-2[/TD]
[TD]S_1820[/TD]
[TD]S_1820-2[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[/TR]
[TR]
[TD]Wash[/TD]
[TD="align: right"]-0.0515[/TD]
[TD="align: right"]-84.63[/TD]
[TD="align: right"]-81.02[/TD]
[TD="align: right"]-82.18[/TD]
[TD="align: right"]-80.59[/TD]
[/TR]
[TR]
[TD]B1[/TD]
[TD="align: right"]17.6[/TD]
[TD="align: right"]25.92[/TD]
[TD="align: right"]26.23[/TD]
[TD="align: right"]25.6[/TD]
[TD="align: right"]25.55[/TD]
[/TR]
[TR]
[TD]B2[/TD]
[TD="align: right"]1.936[/TD]
[TD="align: right"]3.533[/TD]
[TD="align: right"]1.438[/TD]
[TD="align: right"]3.125[/TD]
[TD="align: right"]1.127[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]S_1826[/TD]
[TD]S_1826-2[/TD]
[TD]Sr3380[/TD]
[TD]Sr3380-2[/TD]
[TD]Sr3464[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[TD]ppm[/TD]
[/TR]
[TR]
[TD]Wash[/TD]
[TD="align: right"]-79.82[/TD]
[TD="align: right"]-80.1[/TD]
[TD="align: right"]-0.0011[/TD]
[TD="align: right"]-0.0004[/TD]
[TD="align: right"]-0.0013[/TD]
[/TR]
[TR]
[TD]B1[/TD]
[TD="align: right"]25.61[/TD]
[TD="align: right"]25.66[/TD]
[TD="align: right"]17.6[/TD]
[TD="align: right"]17.36[/TD]
[TD="align: right"]17.51[/TD]
[/TR]
[TR]
[TD]B2[/TD]
[TD="align: right"]3.315[/TD]
[TD="align: right"]1.366[/TD]
[TD="align: right"]1.986[/TD]
[TD="align: right"]1.936[/TD]
[TD="align: right"]1.995[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Sr3464-2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]ppm[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Wash[/TD]
[TD="align: right"]-0.0007[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B1[/TD]
[TD="align: right"]17.52[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]B2[/TD]
[TD="align: right"]1.945[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[nuked]

So essentially you want a piece of code to look at each row and if it is empty in it's entirety, insert a page break?

 

[Simon B]

Yes and no. I want a page break on a blank row, but not every blank row, only the blank row that is above a 'natural' page break, so there may be multiple blocks of data with blank rows separating them, but if the 'natural' page break is in the middle of a block I want to go up from there to the first blank row above and put in a page break. Then continue down and do it all again for the whole list which may be several pages long. So depending on the original data the number of blocks that appears on a printed sheet may vary but they will always be full blocks. Hope that makes sense.

 

[nuked]

Can you post your code if I agree not to comment on it's ugliness?!

 

[ukmikeb]

Hi

Try this :-

Dim Pdiv, PgCt, Pgs
PgCt = 1
Pgs = ActiveSheet.HPageBreaks.Count
Do
    If Pgs = 0 Then
        Exit Do
    End If
    
    Pdiv = ActiveSheet.HPageBreaks(PgCt).Location.Row
    
    If Not IsEmpty(Range("B" & Pdiv).Value) Then
'   Cell is not empty therefore find the first occurrence of blank in Col B above this row
        Do
'          Loopback until there is an empty cell in Col B
            Pdiv = Pdiv - 1
        Loop Until IsEmpty(Range("B" & Pdiv))
'   Set the new Page break above the empty cell
    Set ActiveSheet.HPageBreaks(PgCt).Location = Range("B" & Pdiv)
    End If
    PgCt = PgCt + 1
Pgs = ActiveSheet.HPageBreaks.Count
Loop Until PgCt > ActiveSheet.HPageBreaks.Count

hth

 

[Simon B]

Hi Mike
This looks just the thing, but it's throwing up an error at:
Set ActiveSheet.HPageBreaks(PgCt).Location = Range("B" & Pdiv)

Thanks
Simon

 

[ukmikeb]

Simon

Take a note of variables Pdiv, PgCt and Pgs and put a break on that line of code.

By looking at your Page Break Preview you should be able to identify what is causing the error.

I have to go out for a while so there could be a delay responding if you can't solve the error.

 

[Simon B]

Hi Mike
Yeah, I watched all the variables, and stepped through. All the variables were fine but it still fell over.
I changed the line to:
Range("B" & Pdiv + 1).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
and all works, so not really sure what the problem was. Thanks very much for your help, it's help me finish off the whole macro to give a nice user friendly output.