DONT WANT TO "Rows to Repeat at top" on a condtion

[NimishK]

Hi Anyone

This could be quite challenging.

Have almost browsed through all the possible ideas of coding which i could not code of what i want but really wish to have great logic from you.

Kindly guide me so as to where to write the code in thisWorkbook or some other place

Basically I DONT WANT TO "Rows to Repeat at top" on a condtion.

Have attached the file for your reference.
https://www.dropbox.com/s/463fj7kv9a7uexo/Sample555-Sutures.xlsx?dl=0

here mydata Range refers to the items calculated from Row 15 onwards till the row which = "TOTAL" with additional Two rows and within column borders around

Kindly Print Preview
A. If you look at the file i have not coded but selected "Rows to Repeat at Top" = $14:$14 : Also scaled View to 85%

1. it comes correctly on Every Page
2. Now i would like to repeat the above condition with Coding
Condtion 1 : if mydata range i.e from row 15 to row 71 exceeds and falls into next page or pages in continuation then i want to "Rows to Repeat at Top " = $14:$14

Condition 2 : Suppose mydata range is from rows 15 to rows 57 with "TOTAL" at row 59 then I DONT WANT TO "Rows to Repeat at Top " = $14:$14
Eventhough datarange for Terms and Condtions have exceeded from 1st page onwards
Let me be also clear: Suppose if myData range exceeds more than 1 page or 2 pages then "Rows to Repeat " = $14:$14 but if the mydata Range ends in 2nd page then DONT WANT TO "Rows to Repeat" = $14:$14 on 3rd Page or more pages.

How to achieve the above result ?

Thanks
NimishK

 

[NimishK]

Worf


Have Tested and implemented your last code.
Now It gives me clear idea.


This Time Hpage Breaks = 2
VPagebreaks = 1

As you rightly mentioned

Choosing section 1
Able to see Page 1 and Page 2 with Print Title Rows

Choosing Section 2
Seeing page 3 without Print title but with additional 3 more blank pages.

Will it be possible to achieve the above without selecting the sections and not having a single blank page
as per the below images

NimishK

 

[NimishK]

Please ignore my earlier post i could not send the images
My time was expired

Worf

Have implemented your last code.
It gives me clear idea now

This Time Hpage Breaks = 2
VPagebreaks = 1

Choosing section 1

Able to see Page 1 and Page 2 with Print Title Rows

Choosing Section 2
As you rightly metioned
Seeing page 3 without Print title but with additional 3 more blank pages.

Will it be possible to achieve the above without selecting the sections and not having a single blank page
as per the below images

https://www.dropbox.com/s/njogioovhb5ezij/Pg1-Representation.jpg?dl=0
https://www.dropbox.com/s/7wu3lk2bntawnxz/Pg2-Representation.jpg?dl=0
https://www.dropbox.com/s/wbkwkro18ispepg/Pg3-Representation.jpg?dl=0


NimishK

 

[Worf]

· The code below will eliminate blank pages from the print preview. Note that not all pages that appear to be empty really are. If you get unexpected results, select the apparently blank range and press delete.
· It will be difficult to have a single print preview because titles are being manipulated at run time.

Dim pag() As Range, ws As Worksheet


Sub PrintPreviewPages()                                 ' run this one
Dim r As Range, cp%, tp%, i%, section%, pp As Range, j%
section = Application.InputBox("Choose a section:", "1) with title" & " | " & "2) no title", "1", , , , , 1)
ActiveWindow.View = xlNormalView
ActiveWindow.View = xlPageBreakPreview
PageAddress
Set r = ActiveSheet.[b:b].Find("TOTAL", , xlValues)
i = 1
Do While Intersect(pag(i), r) Is Nothing
    i = i + 1
    If i > 50 Then Exit Do
Loop
Select Case section
    Case 1
        Set pp = pag(1)
        For j = 2 To i
            If Not BlankPage(pag(j)) Then Set pp = Union(pp, pag(j))
        Next
        ws.PageSetup.PrintTitleRows = ws.Rows(14).Address
    Case 2
        Set pp = pag(i + 1)
        For j = i + 2 To UBound(pag)
            If Not BlankPage(pag(j)) Then Set pp = Union(pp, pag(j))
        Next
        ws.PageSetup.PrintTitleRows = ""
End Select
pp.PrintPreview
End Sub


Sub PageAddress()
Dim c%, v%, h%, cln%, rw%, hgth%, wth%
Set ws = ActiveSheet
c = 1
ReDim pag(1 To (ws.VPageBreaks.Count + 1) * (ws.HPageBreaks.Count + 1))     'all pages on that sheet
For v = 0 To ws.VPageBreaks.Count
    For h = 0 To ws.HPageBreaks.Count
        If v = ws.VPageBreaks.Count Then
            If v = 1 Then
                wth = 2 * ws.VPageBreaks(1).Location.Column - 2
            Else
                wth = 2 * ws.VPageBreaks(v).Location.Column - ws.VPageBreaks(v - 1).Location.Column - 1
            End If
        Else
            wth = ws.VPageBreaks(v + 1).Location.Column - 1
        End If
        If h = ws.HPageBreaks.Count Then
            hgth = 2 * ws.HPageBreaks(h).Location.Row - ws.HPageBreaks(h - 1).Location.Row - 1
        Else
            hgth = ws.HPageBreaks(h + 1).Location.Row - 1
        End If
        If v = 0 Then
            cln = 1
        Else
            cln = ws.VPageBreaks(v).Location.Column
        End If
        If h = 0 Then
            rw = 1
        Else
            rw = ws.HPageBreaks(h).Location.Row
        End If
        Set pag(c) = Range(Cells(rw, cln).Address & ":" & Cells(hgth, wth).Address)     ' page address
        c = c + 1
    Next
Next
End Sub


Function BlankPage(p As Range) As Boolean
BlankPage = False
If WorksheetFunction.CountBlank(p) = p.Rows.Count * p.Columns.Count Then BlankPage = True
End Function

 

[NimishK]

Dear Worf

I really dont know How to Thank you for the Efforts you have put in to resolve the issue.
Everything checked and Tested it Works Fine. FYI the earlier corrections also checked in Excel 2007 it works fine. the last one i need to check but am sure it will work perfect in Excel 2007

· It will be difficult to have a single print preview because titles are being manipulated at run time.

Unfortunately the Limitation came in the Way

Sub PBreaksInfo()
ActiveWindow.View = xlPageBreakPreview
MsgBox "#Horizontal page breaks: " & ActiveSheet.HPageBreaks.Count & vbLf & _
"#Vertical page breaks: " & ActiveSheet.VPageBreaks.Count
End Sub

Though you had coded the above of knowing PageBreaks of how many Pages i found the below code
below code from Excel Hpagebreaks Collection - Subscript Out Of Range - Xtreme Visual Basic Talk

The below code shows nos of Page break of each Page with its row no of PageBreak.
Knowing from belowcode now we have nos of Pages and the Row at which PageBreak Line is seen. which i felt to break the limitation of Titles which are being manipulated at run time on basis of this you can help
So
1. Can we create a Row which behaves like PrintTitleRow and is seen at Horz.PageBreak(s) but on a condtion i.e to find "TOTAL" in column B:B Range and

display the following Created Row.

'Created-Row
dim Rw as integer
rw = 14
With Sheets("sheet1")
.Activate
.Columns("A").ColumnWidth = 17.14
.Cells(rw, 1).Font.Bold = True
.Cells(rw, 1).Value = "Surgery/Sutures"
.Cells(rw, 1).WrapText = True

.Columns("B").ColumnWidth = 11.29
.Cells(rw, 2).Font.Bold = True
.Cells(rw, 2).Value = "Code No."

.Columns("C").ColumnWidth = 35
.Cells(rw, 3).Font.Bold = True
.Cells(rw, 3).Value = "Item Description"

.Columns("D").ColumnWidth = 9
.Cells(rw, 4).Font.Bold = True
.Cells(rw, 4).Value = "UOM Pack"

.Columns("E").ColumnWidth = 15.43
.Columns("E").NumberFormat = "0.00"
.Cells(rw, 5).Font.Bold = True
.Cells(rw, 5).Value = "Rate"

.Columns("F").ColumnWidth = 7.14
.Cells(rw, 6).Font.Bold = True
.Cells(rw, 6).Value = "Qty"

.Columns("G").ColumnWidth = 15.43
.Columns("G").NumberFormat = "0.00"
.Cells(rw, 7).Font.Bold = True
.Cells(rw, 7).Value = "Total"

End with

Created-Row(behaves like PrintTitleRow)which is not the Header Row to be seen on each Page till "TOTAL" in column "B:B" is seen
1st Page you see the Created Rows at row 14th.
Next PAge you see at the Top i.e if the "TOTAL" is seen on the NextPage
LAst PAge No Created-Row to be seen because "TOTAL" is not Seen

code from Excel Hpagebreaks Collection - Subscript Out Of Range - Xtreme Visual Basic Talk

Sub HPageBreakTest()
Dim x As Integer
Application.ScreenUpdating = False

With ActiveSheet
MsgBox .HPageBreaks.Count & " Horizontal page breaks counted"
For x = 1 To .HPageBreaks.Count
    ActiveWindow.ScrollRow = .HPageBreaks(x).Location.Row
    MsgBox "pgbreak at row: " & .HPageBreaks(x).Location.Row
Next x
ActiveWindow.ScrollRow = 1
End With

Application.ScreenUpdating = True
End Sub

Nimish

 

[Worf]

Please test this:

Dim pag() As Range, ws As Worksheet


Sub PrintPreviewPages()                                                                 ' run this one
Dim r As Range, cp%, tp%, i%, section%, pp As Range, j%, oset%
ActiveWindow.View = xlNormalView
ActiveWindow.View = xlPageBreakPreview
PageAddress
Set r = ActiveSheet.[b:b].Find("TOTAL", , xlValues)
i = 1
Do While Intersect(pag(i), r) Is Nothing
    i = i + 1
    If i > 50 Then Exit Do
Loop
For j = 2 To i
    If pag(j).Find("Item Description", , xlValues) Is Nothing Then                      ' needs header
            oset = 0
            If WorksheetFunction.CountBlank(pag(j).Rows(1)) < pag(j).Columns.Count Then
                pag(j).Cells(1, 1).EntireRow.Insert                                     ' first row not empty
                oset = -1
            End If
            pag(1).Rows(14).Copy pag(j).Rows(1).Offset(oset)                            ' copy header
    End If
Next
PageAddress                                                                             ' update array
Set pp = pag(1)
For j = 2 To UBound(pag)
    If Not BlankPage(pag(j)) Then Set pp = Union(pp, pag(j))
Next
pp.PrintPreview
End Sub


Sub PageAddress()
Dim c%, v%, h%, cln%, rw%, hgth%, wth%
Set ws = ActiveSheet
c = 1
ReDim pag(1 To (ws.VPageBreaks.Count + 1) * (ws.HPageBreaks.Count + 1))     'all pages on that sheet
For v = 0 To ws.VPageBreaks.Count
    For h = 0 To ws.HPageBreaks.Count
        If v = ws.VPageBreaks.Count Then
            If v = 1 Then
                wth = 2 * ws.VPageBreaks(1).Location.Column - 2
            Else
                wth = 2 * ws.VPageBreaks(v).Location.Column - ws.VPageBreaks(v - 1).Location.Column - 1
            End If
        Else
            wth = ws.VPageBreaks(v + 1).Location.Column - 1
        End If
        If h = ws.HPageBreaks.Count Then
            hgth = 2 * ws.HPageBreaks(h).Location.Row - ws.HPageBreaks(h - 1).Location.Row - 1
        Else
            hgth = ws.HPageBreaks(h + 1).Location.Row - 1
        End If
        If v = 0 Then
            cln = 1
        Else
            cln = ws.VPageBreaks(v).Location.Column
        End If
        If h = 0 Then
            rw = 1
        Else
            rw = ws.HPageBreaks(h).Location.Row
        End If
        Set pag(c) = Range(Cells(rw, cln).Address & ":" & Cells(hgth, wth).Address)     ' page address
        c = c + 1
    Next
Next
End Sub


Function BlankPage(p As Range) As Boolean
BlankPage = False
If WorksheetFunction.CountBlank(p) = p.Rows.Count * p.Columns.Count Then BlankPage = True
End Function

 

[NimishK]

Worf
Thank you so much dear. You made my day. So Excited am really out of my chair
and taking time to type the following reply
just tested your code in Excel 2007. it is running perfectly

Really appreciate your hard efforts and making this possible

Thanks once again

NimishK

 

[Worf]

You are welcome

I still want to write a generic version that will work with any number of page breaks, including none.

 

[NimishK]

Oh thats Great

Will await your generic version

Few Suggestions for the generic version

1. How about Considering the following additions "coded below". So that the contents (rows and Columns) fits exactly fits on one page. Determines the page break exactly as per the fitment of contents then PrintTitle rows after each Pg break as per the condition

With Activesheet.Pagesetup
       .Zoom = False      
        .FitToPagesWide = 1
       .FitToPagesTall = 1
End With

2. Suggestion: considering the rows or cells in each row with text being Wrapped in a cell. the std. row.height is 15. as per worksheet
3. Can anything be worked on Merged Cells
4. Make it your Own Blog on the same with Generic Version on suggestion 1, 2, 3rd if possible else 1 and 2 will do:wink:

FYI with suggestion 2 also checked another sheet what happens the PrintTitle row goes down if the row with cells within the range is wrapped

All the Best Dear

NimishK

 

[Worf]

Hi

- The following code should determine page addresses with any number of page breaks.
- It offers an option to colour code the page ranges.
- It can be adapted to special cases such as presence of manual page breaks.
- I’ll be back later to analyse your suggestions.

Tag: Excel worksheet page address

Sub Macro1()        ' run this one
PageAddress2 True
End Sub


Sub PageAddress2(colorcode As Boolean)
Dim c%, v%, h%, cln%, rw%, hgth%, wth%, s$, ws As Worksheet
Set ws = ActiveSheet
c = 1: s = ""
ActiveWindow.View = xlPageBreakPreview
ReDim pag(1 To (ws.VPageBreaks.Count + 1) * (ws.HPageBreaks.Count + 1))     'all pages on that sheet
For v = 0 To ws.VPageBreaks.Count
    For h = 0 To ws.HPageBreaks.Count
        If v = ws.VPageBreaks.Count Then
            wth = ws.UsedRange.Columns(ws.UsedRange.Columns.Count).Column
        Else
            wth = ws.VPageBreaks(v + 1).Location.Column - 1
        End If
        If h = ws.HPageBreaks.Count Then
            hgth = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
        Else
            hgth = ws.HPageBreaks(h + 1).Location.Row - 1
        End If
        If v = 0 Then
            cln = 1
        Else
            cln = ws.VPageBreaks(v).Location.Column
        End If
        If h = 0 Then
            rw = 1
        Else
            rw = ws.HPageBreaks(h).Location.Row
        End If
        Set pag(c) = Range(Cells(rw, cln).Address & ":" & Cells(hgth, wth).Address)     ' page address
        s = s & pag(c).Address & vbLf
        If colorcode Then pag(c).Interior.Color = RGB(CInt(250 * Rnd), CInt(250 * Rnd), CInt(250 * Rnd))
        c = c + 1
    Next
Next
'MsgBox s           ' all addresses
End Sub

 

[NimishK]

Color Option oh i didnt think of that. Tested at my End in Excel 2007. Good one.
Awaiting the further replies to the suggestions