How can I stop my page generator from randomly incrementing?

Question

Ok so what I want to is to place in the right hand footer a page number for an excel report.

To do this I am using a VBA macro to generate the pages and the information is copied from the Header details sheet to a copy of the template sheet which then is used an actual page for the report.

The problem is that the intro page prints with the initial value as expected but when going to the next page it randomly increments by 8 so it becomes "page 9 of x". How can I stop it from doing this random jump?

Report Pages

Sub ReportPages()

Dim areas As Integer
Dim pageNumberTotal As Integer
areas = 1
' Unhides the Template sheet so it is ready to be used.
Worksheets("Template").Visible = True

' Add new pages based on the header details sheet.
Sheets("Header Details").Select

' Select cell A14 as the basis to fill out the template with data.
Range("A14").Select

Do While IsEmpty(ActiveCell) = False
    ActiveCell.Offset(1, 0).Select
    areas = areas + 1
Loop

pageNumberTotal = areas + 5

' Matches the amount of areas tested that have been specified in the Header Details sheet
Do While areas > 1
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = areas - 1 Then
        exists = True
        End If
    Next i
    If exists = True Then
        areas = areas - 1
        exists = False
    Else
        ' Decrement by 1 and copy the relevant data to the template.
        areas = areas - 1
        Sheets("Template").Select
        Sheets("Template").Copy After:=Worksheets("Template")
        Sheets("Template (2)").Select
        Sheets("Template (2)").Name = areas
        Range("I6").Select
        ActiveCell = areas
        ' Call the WetDry function and then protect the sheet.
        Call WetDry

    End If
Loop

' Closes the template sheet when it is done.
Worksheets("Template").Visible = False

'If ActiveSheet.Name = 1 Then
    'Dim pageNumberSetting As String
    'Dim pageNumber As Integer
    'pageNumber = 1
    'Sheets("Front Page").Select
    ' Sets the font type and size of the page number and page total in the bottom right hand corner of the page.
    'pageNumberSetting = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000." & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
    'With ActiveSheet.PageSetup
        '.RightFooter = pageNumberSetting
    'End With


    'pageNumber = pageNumber + 1
    'ActiveSheet.Next.Activate 
'End If
    ' Calls the next function and passes the value of the page number setting.
    Call FrontBackPages       
 End Sub

Front and Back Pages

Sub FrontBackPages()

' Sets the preliminary features for the start of the report.
' Declarations of variables.
If ActiveSheet.Name = 1 Then
    Dim pageNumberSetting As String
    Dim pageNumber As Integer
    pageNumber = 1
    Sheets("Front Page").Select

    ' Debug message - please ignore.
    ' MsgBox " The Name of the active sheet is " & ActiveSheet.Name


    ' Sets the font type and size of the page number and page total in the bottom right hand corner of the page.
    pageNumberSetting = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000." & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
    With ActiveSheet.PageSetup
        .RightFooter = pageNumberSetting

    End With

    pageNumber = pageNumber + 1
    ActiveSheet.Next.Activate

    ' Selects the "Appx Summary" sheet and propegates it with information from other parts of the workbook,
    ' generates a page number for this part of the report.
    Do While ActiveSheet.Name <> "Appx Summary"
        pageNumberParameter = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000."

        ' If the active sheet condition is met then the "Slip Resistance Testing" sheet is selected and is
        ' given a page number that will be placed in the lower right hand corner of the page.
        If ActiveSheet.Name = "Slip Resistance Testing" Then
            With ActiveSheet.PageSetup
                .FirstPage.RightFooter.Text = pageNumberParameter
            End With
            pageNumber = pageNumber + 1
            pageNumberParameter = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000."
        End If

        ' The "Template" sheet is selected and the page number is decremented by 1.
        If ActiveSheet.Name = "Template" Then
            pageNumber = pageNumber - 1
        End If

        ' The active sheet is selected and in the right - hand footer is given a page number.
        ' After this the next sheet is activated.
        With ActiveSheet.PageSetup
            .RightFooter = pageNumberParameter
        End With
        pageNumber = pageNumber + 1
        ActiveSheet.Next.Activate
    Loop

    ' The page number is then added to the page and also gives the total page number as well.
    ' This will place the page number in the bottom right hand corner of the page..
        pageNumberParameter = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000."
    With ActiveSheet.PageSetup
        .FirstPage.RightFooter.Text = pageNumberParameter
    End With
End If
' Selectes the "Header Details" sheet and the prompts the user that the pages have been successfully added.
Sheets("Header Details").Select
MsgBox "Pages Added!"

End Sub

What is `ActiveSheet.Next.Activate`? I think that maybe a `for` loop that goes through each worksheet would be better. Also, it's best to [avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — BruceWayne, Mar 11 '20 at 04:59
@BruceWayne Ok I think I see where you are coming from however I am still new to VBA can you give an example of the `for` loop you were talking about? — itnewbsupport9124, Mar 11 '20 at 22:27
Also regarding your comment about the use of .Select & .Activate I agree with the link you sent however I am not in a position where selecting few cells from a sheet is feasible mainly due to the fact that I need to use the whole sheet. — itnewbsupport9124, Mar 11 '20 at 23:15
Another thing to keep in mind is your use of `With`. You turned 1 line of code into 3 which isn't necessarily bad as it will do the same thing, but it is not as clean/efficient. — Mech, Mar 17 '20 at 16:02

Mech · Accepted Answer · 2020-03-19T01:48:38.440

I've reduced the amount of code substantially. I've also cut out resource heavy .activate / .select. I have commented a lot so a lot of explanation shouldn't be needed but I will say that if you need clarification, feel free to reply to this answer.

Notables

I don't know what the call to WetDry does, so I added it where I believe it was meant to be.

Code

    Sub ReportPages()
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False

        Dim wb As Workbook: Set wb = ThisWorkbook
        Dim srcws As Worksheet: Set srcws = wb.Worksheets("Header Details")
        Dim destws As Worksheet: Set destws = wb.Worksheets("Template")
        Dim pageNumber, pageNumberTotal As Integer
        Dim lRow, I As Long
        Dim Sht As Worksheet
        Dim ShtProtect as Integer
        Dim Shtpw as String

        Shtpw = "worksheet password"

        ' Unhides the Template sheet so it is ready to be used.
          destws.Visible = True

        ' Finds last row in Header Details
        lRow = srcws.Cells(srcws.Rows.Count, 1).End(xlUp).Row

        On Error Resume Next
        ' creates new tab (naming it was just an unneeded extra step) and populates I6
        For I = 14 To lRow
            If IsEmpty(srcws.Cells(I, 1).Value) Then Exit For
            For Each Sht In wb.Worksheets
                If Application.Proper(Sht.Name) = Application.Proper(srcws.Cells(I, 1).Value) Then
                    ' check to see if the worksheet is protected
                    If Sht.ProtectContents = True Then
                        ' remove sheet protection
                        Sht.Unprotect Shtpw
                        Shtprotect = 1
                    End If
                    destws.Copy After:=destws
                    srcws.Cells(I, 1).Copy
                    destws.Range("I6").PasteSpecial (xlPasteValues)
                    ' Call the WetDry function and then protect the sheet.
                    Call WetDry
                    ' reapply protection
                    If Shtprotect = 1 then
                       Sht.Protect Shtpw
                       Shtprotect = 0
                    End If
                End If
            Next Sht
        Next I

        ' Establishes total pages
        For I = 1 To wb.Sheets.Count
            If InStr(1, wb.Worksheets(I).Name, "Template (") > 0 Then pageNumberTotal = pageNumberTotal + 1
        Next

        ' populates footer
        For I = 1 To wb.Sheets.Count
            If InStr(1, wb.Worksheets(I).Name, "Template (") > 0 Then
                pageNumber = pageNumber + 1
                wb.Worksheets("Template (" & pageNumber + 1 & ")").PageSetup.RightFooter = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000." & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
            End If
        Next
        wb.Worksheets("Front Page").PageSetup.RightFooter = "&B&9Page 1 of " & pageNumberTotal & "    &K00+000." & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
        wb.Worksheets("Slip Resistance Testing").PageSetup.FirstPage.RightFooter.Text = "&B&9Page " & pageNumber & " of " & pageNumberTotal & "    &K00+000."
        ' Hides the template sheet when it is done.
        destws.Visible = False

        Application.DisplayAlerts = True
        Application.ScreenUpdating = True

        wb.Worksheets("Header Details").Activate
        MsgBox "Pages Added!"
    End Sub

EDIT

Added Shtpw as a single reference for multiple calls within the code.
- This assumes the same password is used on each protected sheet.
Added checks to see if the worksheet was protected in the first place. If so, it will unprotect using the defined password (Shtpw).
Added a second check to see if there originally was a password and reapplies as needed.

Cool! Now a problem that I have been having is that the code jumps from `If Application.Proper(Sht.name)` to the `End If` statement and I had forgot that the sheets are protected where do I put those lines of code in? — itnewbsupport9124, Mar 18 '20 at 08:30
I've updated and commented the code to help you with that aspect. Is everything working well for you? — Mech, Mar 18 '20 at 13:37
Right, I have been running this in debug mode and now it gets stuck in the loop in this if statement `If Sht.ProtectsContents = True Then` and still jumps lines all the way to the `End If` without executing the copy paste to the new sheets.[The Problem](https://gyazo.com/2bcf22878c2d9f6fed80d1cfc2ad9cc4) — itnewbsupport9124, Mar 18 '20 at 22:36
That was an untested addition. I am going to reposition the checks so the `if` fires correctly. (Edit complete). — Mech, Mar 19 '20 at 01:46
I feel that we are getting closer but it still jumps the `If` statement as [found here.](https://gyazo.com/5d8ec000eec64bba1a3aa9d284c60e9b) — itnewbsupport9124, Mar 19 '20 at 04:08
it's not finding the sheet in the cell reference. got a screenshot of your workbook? remember to remove sensitive data if needed. — Mech, Mar 19 '20 at 04:12
I can't select the cell that I want which in this case I6, instead it automatically selects the cell next to it which is H6. Which is for choosing the Intro Page. — itnewbsupport9124, Mar 19 '20 at 04:29
can you change `Sht.Protect Shtpw` to `'Sht.Protect Shtpw` and run it again? — Mech, Mar 19 '20 at 04:34
Unfortunately still makes no difference still missfires jumps straight to the exit condition. — itnewbsupport9124, Mar 19 '20 at 04:42
That was meant to allow you to select the cell :) as for the code selecting the cell, there is nothing there that done that so this is strange. — Mech, Mar 19 '20 at 09:50

How can I stop my page generator from randomly incrementing?

1 Answers1

Notables

Code

EDIT