Miror margins

[theta]

Struggling to solve an issue in an elegant way.

I have created a set of orders that need to be printed back to back (on A6). The way to acheive this is with mirror margins. The items are very detailed and so cannot be completed in word, they contain tables etc all of which is best produced in excel...which does not support mirror margins. The version of excel that it will run on is 2003, possibly 2007.

The data on the sheet is contained within columns H - Z (19 columns). This is the effective page width, with columns being 4.5 wide. What I need to achieve is the following :

1. Copy page 1 to a new sheet with 3 columns kept blank on the left (artificial margin) and one column on empty on the right (gutter) :
3 blank columns + 19 columns of content (29 rows) + 1 gutter right

2. Every 29 rows after that, copy the same detail but reverse the blank columns / gutter e.g. page 2 would be :
1 gutter left + 19 columns of content + 3 blank right

This will effectively produce a mirror margins output on a new sheet, complete with inserted page breaks. The main issue that is troubling me is this - there will be section, defined by a number on column C (section number). A section continues until there is another number in column C - so 'section length' is the row containing the number, down to the next number in column C. If a section is overlapping 2 pages e.g. section length is 4 rows, starts on row 27, but a page is only 29 rows - then I need that page to be cut short at row 26, and the section effectively starting the next page. This is for presentation purposes.

Any ideas? I produce a lot of inserts in excel, and if there are any edits or adjustments required - then the knock on effect to all subsequent pages is massive. I want to get a working solution so I can make changes and format the output quickly.

[theta]

13248 >13249

[mancubus]

in Page 2 of the second Picture, no column left blank. but i assume 1 column must be blank.





Sub vbax_52409()

Dim PasteRange As Range
Dim i As Long, Left3Or1ColCheck As Long

LastRow = Worksheets("Data").Cells.Find("*", , , , xlByRows, xlPrevious).Row
Left3Or1ColCheck = 0

Worksheets.Add after:=Worksheets("Data") 'change ws name to suit
With ActiveSheet
.Name = "DesiredName"
.Range("A:W").ColumnWidth = 4.5
For i = 1 To LastRow Step 29
Left3Or1ColCheck = Left3Or1ColCheck + 1
If Left3Or1ColCheck Mod 2 <> 0 Then 'check number is odd
Set PasteRage = .Range("D" & i)
Else 'check number is even
Set PasteRage = .Range("B" & i)
End If
wsData.Range("H" & i & ":Z" & (i + 28)).Copy
PasteRage.PasteSpecial
Next
End With

End Sub

[snb]

I'd use onlu 3 columns and 6 rows:


Sub M_snb()
Columns(1).ColumnWidth = 13.5
Columns(2).ColumnWidth = 85.5
Columns(3).ColumnWidth = 4.5

Rows("2:7").RowHeight = 6 * Rows(1).RowHeight

sn = Sheet1.Cells(1).CurrentRegion

For j = 1 To UBound(sn) Step 6
Cells(2, 2) = sn(j, 1)
Cells(3, 2) = sn(j + 1, 1)
Cells(4, 2) = sn(j + 2, 1)
Cells(5, 2) = sn(j + 3, 1)
Cells(6, 2) = sn(j + 4, 1)
Cells(7, 2) = sn(j + 5, 1)
Columns(1).ColumnWidth = 4.5 + 9 * Abs((j \ 7 Mod 2) = 0)
Columns(3).ColumnWidth = 4.5 + 9 * Abs((j \ 7 Mod 2) = 1)
Next
End Sub

[Paul_Hossler]

Do you send these directly to a printer?

[theta]

in Page 2 of the second Picture, no column left blank. but i assume 1 column must be blank.





Sub vbax_52409()

Dim PasteRange As Range
Dim i As Long, Left3Or1ColCheck As Long

LastRow = Worksheets("Data").Cells.Find("*", , , , xlByRows, xlPrevious).Row
Left3Or1ColCheck = 0

Worksheets.Add after:=Worksheets("Data") 'change ws name to suit
With ActiveSheet
.Name = "DesiredName"
.Range("A:W").ColumnWidth = 4.5
For i = 1 To LastRow Step 29
Left3Or1ColCheck = Left3Or1ColCheck + 1
If Left3Or1ColCheck Mod 2 <> 0 Then 'check number is odd
Set PasteRage = .Range("D" & i)
Else 'check number is even
Set PasteRage = .Range("B" & i)
End If
wsData.Range("H" & i & ":Z" & (i + 28)).Copy
PasteRage.PasteSpecial
Next
End With

End Sub


Awesome, I'll give it a try and post back.

Many thanks

Luke

[Paul_Hossler]

@mancubus -- does that handle the OP requirement to not split sections?




If a section is overlapping 2 pages e.g. section length is 4 rows, starts on row 27, but a page is only 29 rows - then I need that page to be cut short at row 26, and the section effectively starting the next page. This is for presentation purposes.

[mancubus]

no.
obviously, it copies every 29 rows to new sheet based on 3 blank, 1 blank column rule.
i must have missed that bit.

in order to do that we need to see the document... or at least the overlapping sections must be stated by OP.

[Paul_Hossler]

OP's #2 shows a 'map' of the data. That's what I was looking at to see the most logical way to offer a suggestion.

The 'keep sections together' and the 'page breaks' are where I am now

[mancubus]

some sections are 4 rows and some are 5. we dont know, for ex, 37th section's length.

or is it a 2 page document only and is 7th the only section to pull to next (mirror) page?

[Paul_Hossler]

OP#1 --



- there will be section, defined by a number on column C (section number). A section continues until there is another number in column C - so 'section length' is the row containing the number, down to the next number in column C.


This is what makes it an interesting exercise :think:

[Paul_Hossler]

I'd try this and see if it works or what else it needs

There are some things hardcoded that could be made more general




Option Explicit
Const cdDefaultColumnWidth As Double = 4.5
Const ciStartColumn As Long = 8
Const ciNumberOfColumns As Long = 19
Const ciNumberOfRowsPerPage As Long = 29
Const ciSectionNumberColumn As Long = 3

Sub Mirror()
Dim rOrig As Range, rToBeCopied As Range
Dim iLastRow As Long
Dim sNewSheet As String
Dim wsPrint As Worksheet, wsData As Worksheet
Dim i As Long, j As Long
Dim bOddPage As Boolean
Dim iStartRow As Long, iEndRow As Long, iLastUsedRow As Long


'init
Set wsData = Worksheets("Data")
With wsData
.Select
'helper col used later
.Columns(27).Clear
.ResetAllPageBreaks

'reset last used row
iLastRow = .UsedRange.Rows.Count
iLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
Set rOrig = .Cells(1, 1).Resize(iLastRow, 26)
sNewSheet = .Name & "_4Print"
End With
'delete output sheet and add new one
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(sNewSheet).Delete
Application.DisplayAlerts = True
On Error GoTo 0
ActiveWorkbook.Worksheets.Add.Name = sNewSheet
Set wsPrint = ActiveSheet
wsData.Select

'add helper column
With wsData
.Cells(1, 27).Value = 1
.Cells(2, 27).Resize(iLastRow - 1, 1).FormulaR1C1 = "=R[-1]C+1"
End With

'go down sections and make sure not split accross pages
With wsData
For i = 2 To iLastRow
If .Cells(i, ciSectionNumberColumn).Value > 0 Then
If .Cells(i, 27).Value > ciNumberOfRowsPerPage Then
For j = i - 1 To 1 Step -1
If .Cells(j, ciSectionNumberColumn).Value > 0 Then
.Cells(j, 27).Value = 1
Exit For
End If
Next j
End If
End If
Next i
End With

'copy paste to _4Print
bOddPage = True
iLastUsedRow = 0
iStartRow = 1
wsPrint.Select

With wsData
'add marker
.Cells(1, 27).End(xlDown).Offset(1, 0).Value = 1

For i = 2 To iLastRow
If .Cells(i + 1, 27).Value = 1 Then
iLastUsedRow = iLastUsedRow + 1
iEndRow = i

Set rToBeCopied = Range(.Cells(iStartRow, ciStartColumn), .Cells(iEndRow, ciStartColumn + ciNumberOfColumns - 1))
rToBeCopied.Copy

If bOddPage Then
wsPrint.Cells(iLastUsedRow, 4).Select
bOddPage = Not bOddPage
Else
wsPrint.Cells(iLastUsedRow, 2).Select
bOddPage = Not bOddPage
End If

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

iStartRow = iEndRow + 1
iLastUsedRow = iLastUsedRow + rToBeCopied.Rows.Count - 1

wsPrint.HPageBreaks.Add Before:=wsPrint.Rows(iLastUsedRow + 1)
End If
Next I

'don't need helper col
.Columns(27).Clear

End With

With wsPrint
.Range("A:W").ColumnWidth = cdDefaultColumnWidth
.PageSetup.PrintArea = .Cells(1, 1).Resize(iLastUsedRow, 23).Address
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = False
End With


End Sub