• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 759
  • Last Modified:

Excel VBA - Page setup stalls my macro

Hi, I am trying to run the attached code but the page setup window stalls my macro and I have to close it before the macro continues executing!!l Pease fix my problem!!!
Sub MarkettasMacro()
'
' MarkettasMacro Macro
' Macro recorded 4/21/2009 by Luke Baer
'
 
'
    Application.ScreenUpdating = False
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.Delete Shift:=xlToLeft
    Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Range("H1").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SelectedSheets.PrintPreview
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.25)
        .BottomMargin = Application.InchesToPoints(0.25)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = True
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 73
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.25)
        .BottomMargin = Application.InchesToPoints(0.25)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = True
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 73
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Range("B1").Select
    Columns("A:A").ColumnWidth = 6.71
    Columns("A:A").ColumnWidth = 7
    Range("B7").Select
    Columns("F:F").ColumnWidth = 15.57
    Columns("G:G").ColumnWidth = 20.14
    Columns("G:G").ColumnWidth = 20
    Columns("G:G").ColumnWidth = 20.29
    Columns("I:I").ColumnWidth = 16.86
    Columns("J:J").ColumnWidth = 9.57
    Cells.Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("G8").Select
    Columns("M:M").ColumnWidth = 17.86
    Columns("M:M").ColumnWidth = 16.29
    Columns("O:O").ColumnWidth = 11.29
    Rows("1:1").EntireRow.AutoFit
    Columns("P:P").ColumnWidth = 7.86
    Columns("P:P").ColumnWidth = 7.14
    Columns("P:P").ColumnWidth = 7
    Columns("P:P").ColumnWidth = 6.86
    Columns("P:P").ColumnWidth = 6.71
    Columns("P:P").ColumnWidth = 6.86
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.25)
        .BottomMargin = Application.InchesToPoints(0.25)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = True
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 71
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Dim cur1 As Range
    Dim cur2 As Range
    Set cur1 = Range("A2")
    Windows("today.xls").Activate
    Set cur2 = Range("A2")
    Windows("tomorrow.xls").Activate
    Dim i As Integer
    i = Application.WorksheetFunction.CountA(Range("A:A"))
    Dim range1 As Range
    
    Do While (i > 1)
        Windows("today.xls").Activate
        cur2.Select
        If (Selection.Interior.ColorIndex = 37) Then
            Windows("tomorrow.xls").Activate
            Set range1 = Cells.Find(Selection)
            If Not range1 Is Nothing Then
                MsgBox "round " & i
                range1.EntireRow.ColorIndex = 37
            End If
        ElseIf (Selection.Interior.ColorIndex = 35) Then
            Windows("tomorrow.xls").Activate
            Set range1 = Cells.Find(Selection)
            If Not range1 Is Nothing Then
                MsgBox "round " & i
                range1.EntireRow.ColorIndex = 35
            End If
'        ElseIf (Selection.Interior.ColorIndex = 35) Then
'            Range(cur1 & ":" & cur1.Offset(0, 21)).ColorIndex = 35
        End If
        Set cur1 = cur1.Offset(1, 0)
        Set cur2 = cur2.Offset(1, 0)
        i = i - 1
    Loop
    
    Application.ScreenUpdating = True
End Sub

Open in new window

0
JC_Lives
Asked:
JC_Lives
1 Solution
 
Calvin BrineCommented:
I think you are referring to the print preview screen, not the page setup screen.  To eliminate this from occurring, just remove this line of code.
ActiveWindow.SelectedSheets.PrintPreview

HTH
Cal
0
 
JC_LivesAuthor Commented:
Awesome! Thanks,
0

Featured Post

Granular recovery for Microsoft Exchange

With Veeam Explorer for Microsoft Exchange you can choose the Exchange Servers and restore points you’re interested in, and Veeam Explorer will present the contents of those mailbox stores for browsing, searching and exporting.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now