In Excel VBA why can't I edit my page breaks without using a time delay function beforehand?

I am trying to move all the vertical line breaks to the far right of each sheet, so that all the content fits perfectly onto one sheet. I line 270 of the code below, I find that inserting a time delay there via Application.Wait is the only way I can get the ActiveSheet.VPageBreaks(1).DragOff code to work properly. It seems as though Excel is moving too fast to properly execute the page break commands. Does anyone know a reliable alternative? Also, if anyone has any advice on how to speed up the removal of subtotals on line 69, that would be great too.

Dim lastColumn As Integer
Dim lastColumnLetter As String
Dim lastRow As Integer
Dim madeForMarket As String
Dim marketCount As Integer
Dim episodeCount As Integer
Dim guildCount As Integer
Dim subSectionStartingRow As Integer

Sub testPivot()
    Dim sourceSheet As Worksheet
    Dim pivotSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim subSectionStartingRow As Integer
    
    Dim fieldCount As Integer
    
    If Range("D9").Value = "DRAG MGM FILE HERE and press Ctrl-Shift-M" Then
        End
    End If
    
    RangeRefresh
    
    Set sourceSheet = ActiveSheet

    Sheets.Add(After:=ActiveSheet).Name = "PivotTable"
    Set pivotSheet = ActiveSheet
    sourceSheet.Activate
    ActiveWorkbook.PivotCaches.Create(xlDatabase, ActiveSheet.Name & "!" & Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1)). _
        CreatePivotTable TableDestination:=pivotSheet.Name & "!" & pivotSheet.Range("A1").Address(ReferenceStyle:=xlR1C1), TableName:="PivotTable1"
    
    pivotSheet.Activate
    
    ActiveSheet.PivotTables("PivotTable1").PivotFields("madefor").Orientation = xlRowField
    ActiveSheet.PivotTables("PivotTable1").PivotFields("madefor").Position = 1
    
    ActiveSheet.PivotTables("PivotTable1").PivotFields("episode").Orientation = xlRowField
    ActiveSheet.PivotTables("PivotTable1").PivotFields("episode").Position = 2
            
    ActiveSheet.PivotTables("PivotTable1").PivotFields("relname").Orientation = xlRowField
    ActiveSheet.PivotTables("PivotTable1").PivotFields("relname").Position = 3
              
    ActiveSheet.PivotTables("PivotTable1").PivotFields("epiname").Orientation = xlRowField
    ActiveSheet.PivotTables("PivotTable1").PivotFields("epiname").Position = 4
    
    ActiveSheet.PivotTables("PivotTable1").PivotFields("gldname").Orientation = xlRowField
    ActiveSheet.PivotTables("PivotTable1").PivotFields("gldname").Position = 5
    
    ActiveSheet.PivotTables("PivotTable1").PivotFields("market").Orientation = xlRowField
    ActiveSheet.PivotTables("PivotTable1").PivotFields("market").Position = 6
            
    ActiveSheet.PivotTables("PivotTable1").PivotFields("terr").Orientation = xlRowField
    ActiveSheet.PivotTables("PivotTable1").PivotFields("terr").Position = 7


    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("current"), "Sum of current", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("previous"), "Sum of previous", xlSum
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("total"), "Sum of total", xlSum

    ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlTabularRow
    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels


    Application.ScreenUpdating = False
    Dim pvtFld As PivotField
    For Each pvtFld In ActiveSheet.PivotTables("PivotTable1").PivotFields
        pvtFld.Subtotals(1) = False
        fieldCount = fieldCount + 1
        If fieldCount >= lastColumn Then
            Exit For
        End If
    Next pvtFld
    Application.ScreenUpdating = True

RangeRefresh

ActiveSheet.PivotTables("PivotTable1").ColumnGrand = False
ActiveSheet.PivotTables("PivotTable1").RowGrand = False


Range("A1", lastColumnLetter & lastRow).Copy
Sheets.Add(After:=ActiveSheet).Name = "destinationTable"
Range("A1").PasteSpecial xlPasteValues
Set destinationSheet = ActiveSheet

For Each cell In Range("A1:A10")
    If cell.Value = "" And cell.Offset(0, 1).Value = "" Then
        cell.EntireRow.Delete
    End If
Next cell

RangeRefresh

'add blank rows between made for markets
For Each cell In Range("A2", "A" & lastRow)
    If cell.Value <> cell.Offset(1, 0).Value And cell.Value <> "" Then
        cell.Offset(1, 0).EntireRow.Insert shift:=xlDown
        marketCount = marketCount + 1
    End If
Next cell

'separate the made for markets
For i = 1 To marketCount
    Range("A2").Select
    If ActiveCell = "" Then
        ActiveCell.End(xlDown).Select
    End If
    madeForMarket = ActiveCell.Value
    Range("A1", lastColumnLetter & "1").Copy
    
    On Error Resume Next
    Sheets.Add(After:=ActiveSheet).Name = madeForMarket
    If Err.Number <> 0 Then
        Call MsgBox("Error has occured. Please close all MGM files, re-open, and try again.", vbInformation)
        Err.Clear
        End
        On Error GoTo 0
    Else
        On Error GoTo 0
    End If

    Range("A1").PasteSpecial xlPasteValues
    destinationSheet.Activate
    Range(ActiveCell, ActiveCell.End(xlDown).Offset(0, lastColumn - 1)).Select
    Selection.Copy
    Sheets(madeForMarket).Activate
    Range("A2").Select
    ActiveCell.PasteSpecial xlPasteValues
    Range("A1").Select
    destinationSheet.Activate
    Selection.ClearContents
Next i

Application.DisplayAlerts = False
sourceSheet.Delete
pivotSheet.Delete
destinationSheet.Delete
Application.DisplayAlerts = True

RangeRefresh

Cells.Find(What:="Sum of current", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).EntireColumn.Style = "Comma"
Cells.Find(What:="Sum of previous", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).EntireColumn.Style = "Comma"
Cells.Find(What:="Sum of total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).EntireColumn.Style = "Comma"

For j = 1 To marketCount ' beginning of loop that goes from 1 tab to another
    
    Range("A1").Select
    RangeRefresh
    SortColumnsBySeriesEpisode
    
    Cells.Find(What:="relname", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Select
    
    For Each cell In Range(ActiveCell, ActiveCell.Offset(lastRow, 0))
        If cell.Value <> cell.Offset(1, 0).Value And cell.Value <> "" And cell.Row <> 1 Then
            cell.Offset(1, 0).EntireRow.Insert shift:=xlDown
            showCount = showCount + 1
        End If
    Next cell
    
    RangeRefresh
    
    Cells.Find(What:="episode", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Select
    
    For Each cell In Range(ActiveCell, ActiveCell.Offset(lastRow, 0))
        If cell.Value <> cell.Offset(1, 0).Value And cell.Value <> "" And cell.Offset(1, 0).Value <> "" And cell.Row <> 1 Then
            cell.Offset(1, 0).EntireRow.Insert shift:=xlDown
            episodeCount = episodeCount + 1
        End If
    Next cell
    
    Cells.Find(What:="gldname", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Select
    
    RangeRefresh
    
    For Each cell In Range(ActiveCell, ActiveCell.Offset(lastRow, 0))


        subSectionStartingRow = subSectionStartingRow + 1 ' count subsection
        If cell.Value <> cell.Offset(1, 0).Value And cell.Value <> "" And cell.Offset(1, 0).Value <> "" And cell.Row <> 1 Then
            'MsgBox cell.Row
            cell.Offset(1, 0).EntireRow.Insert shift:=xlDown ' insert 1 below current
            cell.Offset(1, 3).Value = "=sum(" & cell.Offset(0, 3).Address & ":" & cell.Offset(-subSectionStartingRow + 2, 3).Address & ")"
            cell.Offset(1, 4).Value = "=sum(" & cell.Offset(0, 4).Address & ":" & cell.Offset(-subSectionStartingRow + 2, 4).Address & ")"
            cell.Offset(1, 5).Value = "=sum(" & cell.Offset(0, 5).Address & ":" & cell.Offset(-subSectionStartingRow + 2, 5).Address & ")"
            cell.Offset(1, 3).Font.Bold = True
            cell.Offset(1, 4).Font.Bold = True
            cell.Offset(1, 5).Font.Bold = True
            'guildCount = guildCount + 1
            subSectionStartingRow = 0 ' reset
            cell.Offset(2, 0).EntireRow.PageBreak = xlPageBreakManual
            RangeRefresh
        ElseIf cell.Value <> "" And cell.Offset(1, 0).Value = "" Then
             cell.Offset(1, 3).Value = "=sum(" & cell.Offset(0, 3).Address & ":" & cell.Offset(-subSectionStartingRow + 2, 3).Address & ")"
            cell.Offset(1, 4).Value = "=sum(" & cell.Offset(0, 4).Address & ":" & cell.Offset(-subSectionStartingRow + 2, 4).Address & ")"
            cell.Offset(1, 5).Value = "=sum(" & cell.Offset(0, 5).Address & ":" & cell.Offset(-subSectionStartingRow + 2, 5).Address & ")"
            cell.Offset(1, 3).Font.Bold = True
            cell.Offset(1, 4).Font.Bold = True
            cell.Offset(1, 5).Font.Bold = True
            subSectionStartingRow = 0 ' reset
            RangeRefresh
            cell.Offset(2, 0).EntireRow.PageBreak = xlPageBreakManual
        End If
    Next cell
    
    RangeRefresh
    
    Range(lastColumnLetter & 1).Offset(0, 1).Value = "Total By Mkt"
    Range(lastColumnLetter & 1).Offset(0, 2).Value = "Sum of current"
    Range(lastColumnLetter & 1).Offset(0, 3).Value = "Sum of previous"
    Range(lastColumnLetter & 1).Offset(0, 4).Value = "Sum of total"
    
    marketColumnLocation = Cells.Find(What:="market", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Column
    sumOfCurrentColumn = Cells.Find(What:="Sum of current", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Column
    sumOfPreviousColumn = Cells.Find(What:="Sum of previous", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Column
    sumOfTotalColumn = Cells.Find(What:="Sum of total", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Column
    Range(lastColumnLetter & 1).Offset(1, 1).Select
    
    'checks to see if the market of the active row doesn't equal that of the row below, and if not, put the 3 subtotals in that row and clear the variables
     For i = 0 To lastRow
        If ActiveCell.Offset(0, -4).Value <> "" And Range("A" & ActiveCell.Row).Offset(0, marketColumnLocation - 1).Value <> "BSC" Then
            subtotalHolder1 = subtotalHolder1 + Range("A" & ActiveCell.Row).Offset(0, sumOfCurrentColumn - 1).Value
            subtotalHolder2 = subtotalHolder2 + Range("A" & ActiveCell.Row).Offset(0, sumOfPreviousColumn - 1).Value
            subtotalHolder3 = subtotalHolder3 + Range("A" & ActiveCell.Row).Offset(0, sumOfTotalColumn - 1).Value
        End If
        If ActiveCell.Offset(0, -4).Value <> "" And Range("A" & ActiveCell.Row).Offset(0, marketColumnLocation - 1).Value <> "BSC" _
            And Range("A" & ActiveCell.Row).Offset(0, marketColumnLocation - 1).Value <> Range("A" & ActiveCell.Row).Offset(1, marketColumnLocation - 1).Value Then
            ActiveCell.Value = Range("A" & ActiveCell.Row).Offset(0, marketColumnLocation - 1).Value
            ActiveCell.Offset(0, 1).Value = subtotalHolder1
            ActiveCell.Offset(0, 2).Value = subtotalHolder2
            ActiveCell.Offset(0, 3).Value = subtotalHolder3
            subtotalHolder1 = 0
            subtotalHolder2 = 0
            subtotalHolder3 = 0
        End If
        ActiveCell.Offset(1, 0).Select
    Next i
    subtotalHolder1 = 0
    subtotalHolder2 = 0
    subtotalHolder3 = 0
    
    subSectionStartingRow = 0 ' reset
    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Cells.Find(What:="Sum of current", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Select
    Range(ActiveCell, ActiveCell.Offset(0, 2)).EntireColumn.NumberFormat = "#,##0.00"
    Range(ActiveCell, ActiveCell.Offset(0, 2)).EntireColumn.Style = "Comma"
    Cells.Find(What:="Sum of current", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Select
    Range(ActiveCell, ActiveCell.Offset(0, 2)).EntireColumn.NumberFormat = "#,##0.00"
    Range(ActiveCell, ActiveCell.Offset(0, 2)).EntireColumn.Style = "Comma"

    ActiveWindow.View = xlPageBreakPreview
    
    Application.PrintCommunication = False
    ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
    ActiveSheet.PageSetup.PrintGridlines = True
    ActiveSheet.PageSetup.Zoom = 60
    ActiveSheet.PageSetup.Orientation = xlLandscape
    Application.PrintCommunication = True

    Cells.Find(What:="Total By Mkt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Select
    Selection.EntireColumn.Borders(xlEdgeLeft).Weight = xlMedium

    Rows("1:1").Interior.Pattern = xlSolid
    Rows("1:1").Interior.TintAndShade = -0.149998474074526
    Cells.RowHeight = 15
    Application.Wait Now + TimeValue("0:00:09") ' time delay needed to make vertical page break removal possible
    Range("A1").Select
    
    Cells.EntireColumn.AutoFit
    On Error Resume Next
    ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    ActiveSheet.Next.Activate
    On Error GoTo 0
    
Next j

Call MsgBox("Process Complete.", vbInformation)

End Sub


Sub RangeRefresh()

    lastColumn = Range("EZ2").End(xlToLeft).Column
    lastColumnLetter = Split(Columns(lastColumn).Address(), "$")(2)
    lastRow = Range(Columns(1), Columns(lastColumn)).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
End Sub


Public Sub SortColumnsBySeriesEpisode()

    Cells.CurrentRegion.AutoFilter
    Range("A1").Select
    seriesName = ActiveCell.EntireRow.Find(What:="relname", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Offset(1, 0).Address
    episodeNumber = ActiveCell.EntireRow.Find(What:="episode", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Offset(1, 0).Address
    
    ActiveSheet.AutoFilter.Sort.SortFields.Clear
    ActiveSheet.AutoFilter.Sort. _
        SortFields.Add Key:=Range(seriesName & ":" & Range(seriesName).Offset(lastRow - 1, 0).Address), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveSheet.AutoFilter.Sort. _
        SortFields.Add Key:=Range(episodeNumber & ":" & Range(episodeNumber).Offset(lastRow - 1, 0).Address), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveSheet.AutoFilterMode = False
    
End Sub

Open in new window

shampouyaAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

broro183Commented:
hi Shampouya,

The excel 2007 Help files state:
Remarks
This method exists primarily for the macro recorder. You can use the Delete method to delete a page break in Visual Basic.

Example
This example deletes vertical page break one from the active sheet by dragging it off the right edge of print region one.
ActiveSheet.VPageBreaks(1).DragOff xlToRight, 1

I don't have excel 2010 so I can't test this but I think it is worth you giving it a try.

Replace this section with the following section...
'this is your current code from line 255 to line 279
ActiveWindow.View = xlPageBreakPreview
    
    Application.PrintCommunication = False
    ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
    ActiveSheet.PageSetup.PrintGridlines = True
    ActiveSheet.PageSetup.Zoom = 60
    ActiveSheet.PageSetup.Orientation = xlLandscape
    Application.PrintCommunication = True

    Cells.Find(What:="Total By Mkt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).Select
    Selection.EntireColumn.Borders(xlEdgeLeft).Weight = xlMedium

    Rows("1:1").Interior.Pattern = xlSolid
    Rows("1:1").Interior.TintAndShade = -0.149998474074526
    Cells.RowHeight = 15
    Application.Wait Now + TimeValue("0:00:09") ' time delay needed to make vertical page break removal possible
    Range("A1").Select
    
    Cells.EntireColumn.AutoFit
    On Error Resume Next
    ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    ActiveSheet.Next.Activate
    On Error GoTo 0
    
Next j

Open in new window


try changing it to...
'I have read that the next line can slow code execution (esp if the page zoom is not at 100%) and I don't think it is necessary for your code so I have commented it out. 
'ActiveWindow.View = xlPageBreakPreview
 
'I have moved the page setup code further down  & deleted it from here 
        With ActiveSheet
            With .Rows("1:1").Interior
                .Pattern = xlSolid
                .TintAndShade = -0.149998474074526
            End With
            With .Cells
                .Find(What:="Total By Mkt", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole).EntireColumn.Borders(xlEdgeLeft).Weight = xlMedium
                .RowHeight = 15
                .EntireColumn.AutoFit
            End With
            'try without the delay
            'Application.Wait Now + TimeValue("0:00:09")    ' time delay needed to make vertical page break removal possible
            .Range("A1").Select
            
            Application.PrintCommunication = False
            With .PageSetup
                .PrintTitleRows = "$1:$1"
                .PrintGridlines = True
                'does the zoom actually need to be set to 60?
                '(if not, delete it from the code)
                .Zoom = 60
                .Orientation = xlLandscape
                'added the following lines instead of using "drag off"
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Application.PrintCommunication = True

            'is the on error check really necessary?
            On Error Resume Next
            .Next.Activate
            On Error GoTo 0
        End With
    Next j

Open in new window


hth
Rob
broro183Commented:
hi again,

 re the subtotals in row 69:

I don't know if this will be faster or not in excel 2010 but the following code is adapted from Debra Dalgleish's free PivotPower add-in (available from here).

    With ActiveSheet.PivotTables("PivotTable1")
        .ManualUpdate = True
        For Each pvtFld In .PivotFields
            With pvtFld
                .Subtotals(1) = True
                .Subtotals(1) = False
            End With
            'is this section necessary?
            '**********
            fieldCount = fieldCount + 1
            If fieldCount >= lastColumn Then
                Exit For
            End If
            '**********
        Next pvtFld
        .ManualUpdate = False
    End With

Open in new window


hth
Rob
shampouyaAuthor Commented:
The best solution that worked for me at the end was to move the dragoff printline command at line 275 to the very end of the code, within its own loop. That way its not competing for the system's resources as much. I am making a lot of assumptions there but it worked for me that way.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
broro183Commented:
hi Shampouya,

Did you try removing the dragoff line of code completely and replacing it with code to "fit it to one high by one wide" (see below)?
Fitting to one by one  may be faster than using "drag off". If you still want to use dragoff (at the end of your code) I suggest including it between "Application.PrintCommunication = False" & "Application.PrintCommunication = True".

            Application.PrintCommunication = False
            With ActiveSheet.PageSetup
                'added the following lines instead of using "drag off"
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Application.PrintCommunication = true

Open in new window


hth
Rob
shampouyaAuthor Commented:
Thanks for the suggestions, I had a lot of unnecessary code i n there that you pointed out.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.