VBA code to make all worksheets evenly numbered

Milos

Board Regular
Joined
Aug 28, 2016
Messages
103
Hi all,

Can somebody please fix a problem that has ailed me for more than a year!? I need a code designed that will ensure that all worksheets in a workbook will have even page numbers...

With this I was thinking a VBA code that will read the content of each worksheet and assign a page number to each page. If the last page number in any worksheet equated to an even page (e.g. 2, 4, 6, 8, 10 pages etc.) then nothing;

But if the last page number in any worksheet equated to an odd page (e.g. 1, 3, 5, 7, 9 pages etc.) then I would need the code to automatically go down to the next page in that particular worksheet and enter a random value like "make pages even".

Please comment if you know how to design any such VBA code because I am baffled.

Thanks people really appreciate the help,

Milos
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
832
Office Version
2010
Platform
Windows
Maybe something like this ?
Code:
Sub EvenPages()

Dim i As Integer, x As Integer, lr As Long
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    x = ws.PageSetup.Pages.Count
    MsgBox x
    If x Mod 2 = 1 Then
        With ws
            lr = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
            Do Until x Mod 2 = 0
                i = i + 10
                .Cells(lr + i, 1).Value = "make pages even"
                x = ws.PageSetup.Pages.Count
            Loop
            .Range(.Cells(lr + 1, 1), .Cells(lr + i - 1, 1)).ClearContents
        End With
    End If
Next ws

End Sub
 

Milos

Board Regular
Joined
Aug 28, 2016
Messages
103
Thanks for the help NoSparks.

It has worked kind of... although this code seems to be making even pages, unevenly...

I performed a trial with 12 worksheets all only 1 page long (I just put my name "Milos" in cell A1 for all of the 12 worksheets and nothing else). The message box worked perfectly: 1,1,1,1,1,1,1,1,1,1,1,1 etc.
But when I went to check the pages for the "make pages even" message, the message was distributed unevenly in the worksheets: 2,2,2,2,4,4,4,4,4,6,6,6 etc. It seemed to keep building the message further and further away from my actual page with non-blanks cells. I was expecting all the pages to be 2,2,2,2,2,2,2,2,2,2,2,2,2 etc.

How should I amend this code? I need the macro search for the last row (e.g. column A) with non-blank cells in each worksheet and then if the count is an odd number to go directly down to the next page and enter the message?

Thanks again,
 

Fazza

MrExcel MVP
Joined
May 17, 2006
Messages
9,193
how is this, Milo?

Code:
Sub even_pages()


  Const sFiller As String = "make pages even"


  Dim i As Long
  Dim lRow As Long
  Dim wks As Excel.Worksheet


  For Each wks In Worksheets
    
    wks.Activate
    wks.ResetAllPageBreaks
    
    lRow = wks.UsedRange.Rows.Count
   
    i = 1
    wks.UsedRange.Select
    If ExecuteExcel4Macro("GET.DOCUMENT(50)") Mod 2 = 1 Then
      wks.Cells(lRow + i, 1).Value2 = sFiller
      Do Until ExecuteExcel4Macro("GET.DOCUMENT(50)") Mod 2 = 0
        wks.Cells(lRow + i, 1).ClearContents
        i = i + 1
        wks.Cells(lRow + i, 1).Value2 = sFiller
        wks.UsedRange.Select
      Loop
    End If
    
  Next wks
  Set wks = Nothing


End Sub
 

Milos

Board Regular
Joined
Aug 28, 2016
Messages
103
Awesome! It is currently passing my tests (fingers crossed; play it cool :cool:)!!!

Thanks for solving my year long riddle.
 

Fazza

MrExcel MVP
Joined
May 17, 2006
Messages
9,193
Great to hear, Milos (y)

I do wonder if it might be a little slow on large files.

All the best, Fazza

PS if it is slow, try adding a line near the beginning "application.screenupdating = false". i should have done that anyway and maybe a couple of others if you have other code or lots of calculations
 
Last edited:

Milos

Board Regular
Joined
Aug 28, 2016
Messages
103
Hey Frazza,

Almost… I am sorry to keep bugging you but I still need a little help here. I have only just gotten a chance to use this macro out with my actual data.

I used this macro to print off approximately 1000 pages (trying to save paper). I encountered a few issues but it still made my life far easier than before! I got several issues randomly halting my progress throughout including error 440 (automation error) and error 13 (mismatch error). What is clear is that the macro will only work for pages that are only 1 page long (which worked well as most of my pages are only 1 page long). I have performed several of tests and will described to you how the macro functioned:

Test 1 (on 7 worksheets): 6, 1, 7, 1, 1, 1 and 2 pages.
Test 1 with macro = 6, 2, 7, 2, 2, 2 and 2 pages.

Test 2 (on 8 worksheets): 1, 1, 2, 5, 5, 1, 3 and 4 pages.
Test 2 with macro = 2, 2, 2, 5, 5, 2, 3 and 4 pages.

Test 3 (on 20 worksheets): 10, 2, 1, 2, 4, 1, 1, 6, 3, 1, 4, 2, 4, 3, 1 and 12 pages.
Test 3 with macro: 10, 2, 2, 2, 4, 2, 2, 6, 3, 2, 4, 2, 4, 3, 2 and 12 pages.

Test 4 (on 1 worksheet): 4 pages.
Test 4 with macro = Run time error 13 mismatch error. I don't know what is different about this data

Test 5 (on 2 worksheets): 4 and 1 pages.
Test 5 with macro = Run time error 13 mismatch error.

What I need is a way to avoid the two errors and for the macro to work on all odd pages.
 

Fazza

MrExcel MVP
Joined
May 17, 2006
Messages
9,193
hi Milos

please explain how you used/implemented the code

thanks
 
Last edited:

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
832
Office Version
2010
Platform
Windows
Maybe this will work, it just adds a page break then "make pages even" on next line
Code:
Sub EvenPages_try2()

Dim lr As Long, ws As Worksheet

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
    With ws
        .Activate
        If .PageSetup.Pages.Count Mod 2 = 1 Then
            lr = .Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
            .HPageBreaks.Add Before:=Rows(lr + 1)
            .Cells(lr + 1, 1).Value = "make pages even"
        End If
    End With
Next ws

Application.ScreenUpdating = True

End Sub
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
832
Office Version
2010
Platform
Windows
Good, bad or indifferent, care to acknowledge the last suggestion ?
 

Forum statistics

Threads
1,082,478
Messages
5,365,783
Members
400,850
Latest member
Raj_Jpr

Some videos you may like

This Week's Hot Topics

Top