• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

For print, distribute data base on number of columns

So that simplifies a bit the code and it will be a mix of both ways for a better efficiency …​
It works according to the source data columns width, the paper size, margins and top header to repeat, …​
… so to be managed by an user.​
According to your 4 columns attachment, as it is the result is a 4 columns x 2 blocks.​
After operating a well fit page setup by reducing the margins to a reasonable one centimeter (0.4 inch) for example,​
the result should turn to a 4 columns x 3 depending on an empirical parameter, to be continued …​
If it works for your 4 columns workbook, it works too for your other 2 & 3 columns.​
(I'm still testing - when I have time - the workarounds between different computers screen setup, an Excel well known 'issue'.)
Another question :​
where should be located the code : within the source data workbook (so to be saved as .xlsb / .xlsm) or explain the user context ?​
Dear Sir @Marc L ,
I always store all success & invaluable (atleast for me) codes in personel.xlsb... many thanks for your precise effort..
Regards,
Chirag Raval
 

Marc L

Excel Ninja
I had to restart back from automatizing what any Excel beginner user - even a child ! - can yet operate manually​
so now it's an empirical way still managing workarounds but more reliable than the previous try …​
As a starter, this demonstration copies the source sheet (aka Set Ws = Sheet1) to a new sheet 'Result'​
in order to keep the source columns block as it is, easier & safer for a testing purpose,​
then it fits the maximum blocks # according to the source page setup :​
Code:
Sub DemoE1()
      Const S = "Result"
        Dim Ws As Worksheet, Rw As Range, C%, R&, P&, W(), L%, N%
        Set Ws = Sheet1
        Set Rw = Ws.[A1].CurrentRegion.Rows
        C = Rw.Columns.Count
         If Ws.UsedRange.Columns.Count > C Then Ws.Columns(C + 1).Resize(, Columns.Count - C).Delete
        R = Rw.Count
         If Ws.UsedRange.Rows.Count > R Then Ws.Rows(R + 1 & ":" & Rows.Count).Delete
    With Application
      .DisplayAlerts = False:  .ScreenUpdating = False
      .Goto Ws.[A50], True
        P = Ws.HPageBreaks(1).Location.Row
      .Goto [A1], True
    End With
    If P > R Then
            Ws.PrintPreview
    Else
            If Evaluate("ISREF('" & S & "'!A1)") Then Sheets(S).Delete
            Ws.Copy , Ws
            ActiveSheet.Name = S
            Set Rw = Range(Rw.Address).Rows
            ReDim W(C):  W(0) = 3:  For P = 1 To C:  W(P) = Cells(P).ColumnWidth:  Next
            Cells(Columns.Count) = " "
        Do
            Rw(1).Copy Cells(L + 1)
            L = L + C + 1
            N = N + 1
            Cells(L).Resize(, C + 1).ColumnWidth = W
        Loop While L + C < ActiveSheet.VPageBreaks(1).Location.Column
        If N > 1 Then
                 L = L - 1
            With [A1].Resize(, L).SpecialCells(xlCellTypeBlanks)
                     .ColumnWidth = Ws.StandardWidth
                While ActiveSheet.VPageBreaks(1).Location.Column <= L
                     .ColumnWidth = .ColumnWidth - 0.4
                Wend
            End With
                R = (R - 1) / N
                For P = 1 To N - 1:  Rw(2 + R * P).Resize(R).Cut Cells(2, 1 + (C + 1) * P):  Next
                Columns(Columns.Count).Delete
        Else
            Sheets(S).Delete:  Beep
        End If
    End If
        With Application:  .DisplayAlerts = True:  .ScreenUpdating = True:  End With
        Set Ws = Nothing:   Set Rw = Nothing
End Sub
Do you like it ? So thanks to click on bottom right Like !​
 

Marc L

Excel Ninja
Managing page breaks is the main issue I met since last century whatever the Excel version and,​
like for pivot, the behavior changes from a version to another one, as often Excel is buggy, tricky, …​
The reason why I placed the Goto codeline just before …​
When the first row displayed is the #50, do you see under the horizontal page break in the same page screen ?​
Operate a print preview of the source data sheet before launching the demo in order to see the page breaks.​
BUT it seems you have amended the demonstration as 'application' does not appears in Proper style like within my code,​
or you have another procedure in the same module, an event firing, whatever …​
AS a reminder : Sheet1 is the source data sheet obviously in the workbook where is located the procedure​
so first for a testing purpose paste at least my demonstration as it is - no mod - in a standard module - like Module1 - of​
an original workbook from your attachment, but alone …​
 
Dear Sir @Marc L ,

Thanks, I already go to print preview & back to normal view to fall / flash /force to present page break objects on sheet..but , with just copy paste your code in personnel.xlsb (without any mod, just change Sub name) ...& i missed as per your instruction, now I should ,/.will run your code in original Workbook., in sheet1, .in single newly generated module, I will revert soon...Sir..

Regards,

Chirag Raval
 

Marc L

Excel Ninja
You fell in the first trap as in your personal workbook Sheet1 is obviously not the Sheet1 codename of your initial attachment …​
 
Dear Sir @Marc L ,
Thanks for pin point that, now I will generate new file , data in sheet1 (codename of sheet, not sheet"s name which visible to user ) , copy your code in new module in that workbook , without any modification, , generate new sheet, name it "Result", copy data of sheet 1 to Result sheet & run your code. But..sorry, all can be happen Tomorrow, its now 11:55 pm at night in India, my body need sleep, & also all data & workbooks in my work office, i have no pc at home, i will be defiantly revert .till then many thanks your I invaluable efforts...

Regards,
Chirag Raval
 
Dear Sir,

Amazing ...Just Run as Desired.... And perfectly page breaks on every 50 & in multiple rows, ...Great Sir,...Thank you..

But... work only in Unique workbook..that have only module1 ...can it run through personnel.xlsb? ...if that happen, Whole thread meet the solution...

Regards,

Chirag Raval
 

Marc L

Excel Ninja
This first demonstration just reproduces what anyone can operate manually …​
To run it from your personal workbook just replace Sheet1 by a valid sheet reference​
like you used in other procedures of this personal workbook …​
 
Top