column formatting

[glazejs]

I need to print a list of approx 10,000 attendees of an event. Want to print 2 columns per page.

The list is currently all in column A and B (first name, last name). Rows are 1 - 10,000

I want to format automatically so all the names from page 2, go to columns D-F on Page 1. And then the data from Page 3 moves up to replace what was on Page 2. (I understand that I can, after the reformatting, sort by Column B, and delete all the blank pages at the bottom).

Etc.

So instead of having 200 pages of Column A and B, I have 100 pages of Columns A/B and D/F

Thnx

 

[Ruddles]

Do you mean A/B and D/E? If so, try this code:-

[FONT=Fixedsys]Option Explicit[/FONT]
 
[FONT=Fixedsys]Const START_ROW As Long = [COLOR=red]2[/COLOR][/FONT]
[FONT=Fixedsys]Const PAGE_LENGTH As Long = [COLOR=red]50[/COLOR][/FONT]
 
[FONT=Fixedsys]Public Sub Repaginate()[/FONT]
 
[FONT=Fixedsys] Dim ws As Worksheet[/FONT]
 
[FONT=Fixedsys] Dim iLastRow As Long[/FONT]
[FONT=Fixedsys] Dim iPage As Long[/FONT]
[FONT=Fixedsys] Dim iRow As Long[/FONT]
 
[FONT=Fixedsys] Dim iPages As Long[/FONT]
 
[FONT=Fixedsys] Dim dtStart As Date[/FONT]
 
[FONT=Fixedsys] dtStart = Now()[/FONT]
[FONT=Fixedsys] Set ws = ThisWorkbook.Sheets("[COLOR=red]Sheet1[/COLOR]")[/FONT]
[FONT=Fixedsys] iLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row[/FONT]
 
[FONT=Fixedsys] Application.Cursor = xlWait[/FONT]
[FONT=Fixedsys] Application.ScreenUpdating = False[/FONT]
 
[FONT=Fixedsys] iPages = 0[/FONT]
[FONT=Fixedsys] For iPage = START_ROW To iLastRow Step PAGE_LENGTH * 2[/FONT]
[FONT=Fixedsys]   For iRow = iPage To iPage + PAGE_LENGTH - 1[/FONT]
[FONT=Fixedsys]     ws.Cells(iRow, 4) = ws.Cells(iRow + PAGE_LENGTH, 1)[/FONT]
[FONT=Fixedsys]     ws.Cells(iRow, 5) = ws.Cells(iRow + PAGE_LENGTH, 2)[/FONT]
[FONT=Fixedsys]     ws.Cells(iRow + PAGE_LENGTH, 1).ClearContents[/FONT]
[FONT=Fixedsys]     ws.Cells(iRow + PAGE_LENGTH, 2).ClearContents[/FONT]
[FONT=Fixedsys]   Next iRow[/FONT]
[FONT=Fixedsys]   iPages = iPages + 1[/FONT]
[FONT=Fixedsys] Next iPage[/FONT]
 
[FONT=Fixedsys] For iRow = iLastRow To START_ROW Step -1[/FONT]
[FONT=Fixedsys]   If IsEmpty(ws.Cells(iRow, 1)) Then ws.Rows(iRow).EntireRow.Delete[/FONT]
[FONT=Fixedsys] Next iRow[/FONT]
 
[FONT=Fixedsys] Application.ScreenUpdating = False[/FONT]
[FONT=Fixedsys] Application.Cursor = xlDefault[/FONT]
 
[FONT=Fixedsys] MsgBox vbCrLf _[/FONT]
[FONT=Fixedsys]      & Format(iLastRow - START_ROW + 1, "#,###") & " rows rearranged on to " & iPages & " pages." _[/FONT]
[FONT=Fixedsys]      & Space(10) & vbCrLf & vbCrLf _[/FONT]
[FONT=Fixedsys]      & "Run time: " & Format(Now() - dtStart, "hh:nn:ss"), _[/FONT]
[FONT=Fixedsys]      vbOKOnly + vbInformation[/FONT]
 
[FONT=Fixedsys]End Sub[/FONT]

You'll need to set the name of the sheet, the start row for the data (1=no titles, 2=titles on row 1) and the number of lines you want on each page. Note that this writes the newly-paginated data back onto the source worksheet so make sure you have a backup of your data in 'standard' format before you run the code.

I suggest you start with a small sample of your data - maybe a hundred lines or less - and a very small page size, and satisfy yourself that the code works exactly correctly before you rely on it for your final output run. Make sure all the names are copied and none are missed and that the page transitions occur at the correct points.

Any problems, just get back to me within the warranty period and I'll put you right at the end of the queue.

 

[Ruddles]

As a rough guide, the run time here for 10k rows was fifteen seconds.