Link to home
Start Free TrialLog in
Avatar of JC_Lives
JC_LivesFlag for United States of America

asked on

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

ASKER CERTIFIED SOLUTION
Avatar of Calvin Brine
Calvin Brine
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of JC_Lives

ASKER

Awesome! Thanks,