asked on

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

SOLUTION

Rob Brockett

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Rob Brockett

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

ASKER CERTIFIED SOLUTION

shampouya

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Rob Brockett

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

shampouya

ASKER

Thanks for the suggestions, I had a lot of unnecessary code i n there that you pointed out.