debug code

[FROGGER24]

I have a some code that we use in our office that works ok on my pc. When others in the office try to use the macro the year gets changed to 19 instead of 09. The only problem I have is that the code seems to slow down when it is trying to print the worksheet out. Can the code be shortened up/cleaned up. We are looking for gridlines with inside /outside lines, landscape and left/right margins of .25

Sub IC_Delays()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Add
Windows("Delays List.xls").Activate
Range("F15:N" & Cells(Rows.Count, "F").End(xlUp).Row).Copy
Windows("Book4").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("A1:I" & Cells(Rows.Count, "A").End(xlUp).Row).Select
Selection.Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlYes
Columns("F:G").Insert Shift:=xlToRight
Range("F1") = "Delay Start"
Range("G1") = "Delay Stop"
Range("F2").FormulaR1C1 = "=RC[2]+RC[3]"
Range("G2").FormulaR1C1 = "=RC[3]+RC[4]"
Range("F2:G" & Cells(Rows.Count, "A").End(xlUp).Row).FillDown
Columns("F:G").NumberFormat = "m/d/yy h:mm;@"
Cells.EntireColumn.AutoFit

Range("L2").FormulaR1C1 = "=IF(RC[-10]&RC[-7]=R[-1]C[-10]&R[-1]C[-7],0,1)"
Range("L2:L" & Cells(Rows.Count, "G").End(xlUp).Row).FillDown

Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

lastrow = Cells(Rows.Count, "G").End(xlUp).Row
For i = lastrow - 1 To 2 Step -1
If Range("L" & i).Value = 0 Then Rows(i).EntireRow.Delete
Next i
Range("E1").AutoFilter Field:=5, Criteria1:=">=2.5"
Windows("Delays List.xls").Close
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & Range("A1").End(xlDown).Row

Range("A1:G" & Range("A1").End(xlDown).Row).Select
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
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & Range("A1").End(xlDown).Row
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

 

[jbeaucaire]

Here are some improvements, you can delete the rows that =0 in column L using an AutoFilter instead of a loop.

FILLDOWN is usually not necessary since if you can enter a formula in one cell, you can enter it in the entire range at the same time.

Also, I am SURE the With PAGESETUP stuff at the end you can whittle off all the lines that show your default values since they aren't including any "changes", look at trimming that down.

Sub IC_Delays()
Dim NewBk As Workbook, LR As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Add
Set NewBk = ThisWorkbook
Windows("Delays List.xls").Activate
Range("F15:N" & Cells(Rows.Count, "F").End(xlUp).Row).Copy
NewBk.Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Windows("Delays List.xls").Close

LR = Range("A" & Rows.Count).End(xlUp).Row

Range("A1:I" & LR).Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlYes
Columns("F:G").Insert Shift:=xlToRight
Range("F1") = "Delay Start"
Range("G1") = "Delay Stop"
Range("F2:F" & LR).FormulaR1C1 = "=RC[2]+RC[3]"
Range("G2:G" & LR).FormulaR1C1 = "=RC[3]+RC[4]"
Columns("F:G").NumberFormat = "m/d/yy h:mm;@"
Cells.EntireColumn.AutoFit

Range("L2:L" & LR).FormulaR1C1 = "=IF(RC[-10]&RC[-7]=R[-1]C[-10]&R[-1]C[-7],0,1)"

ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

Range("A1").AutoFilter
Range("A1").AutoFilter Field:=12, Criteria1:="=0"
Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete (xlShiftUp)
Range("A1").AutoFilter Field:=5, Criteria1:=">=2.5"
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & Range("A1").End(xlDown).Row

ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With

Range("A1:G" & LR).Borders.LineStyle = xlContinuous
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & LR
With ActiveSheet.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.25)
    .RightMargin = Application.InchesToPoints(0.25)
    .TopMargin = Application.InchesToPoints(1)
    .BottomMargin = Application.InchesToPoints(1)
    .HeaderMargin = Application.InchesToPoints(0.5)
    .FooterMargin = Application.InchesToPoints(0.5)
    .PrintHeadings = False
    .PrintGridlines = True
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlLandscape
    .Draft = False
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .PrintErrors = xlPrintErrorsDisplayed
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[FROGGER24]

Thanks for the reply, but I am having a issue with the workbook portion of the code. It appears to be pasting the data onto my workbook called Gom Macro instead of the new workbook that was created.

Dim NewBk As Workbook, LR As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Workbooks.Add
Set NewBk = ThisWorkbook
Windows("Delays List.xls").Activate
Range("F15:N" & Cells(Rows.Count, "F").End(xlUp).Row).Copy
NewBk.Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Windows("Delays List.xls").Close

 

[wigi]

I have not looked at it in detail, but I guess change:

Set NewBk = ThisWorkbook

to

Set NewBk = ActiveWorkbook

 

[FROGGER24]

I am having problems with this section of the code,the error message is "Autofilter method of range failed"

Range("A1").AutoFilter
Range("A1").AutoFilter Field:=12, Criteria1:="=0"
Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete (xlShiftUp)
Range("A1").AutoFilter Field:=5, Criteria1:=">=2.5"
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & Range("A1").End(xlDown).Row

 

[jbeaucaire]

Use F8 inside the VBEditor to walk your way through the code until you get to that line, the line before is supposed to have turned on the autofilter. Did it?

The line in question expect there to be 12 drop boxes and it tries to autofilter on column L, the 12th one. Are there 12?

 

[FROGGER24]

I added this line of code so that my data would show...
ActiveSheet.Range("$A$1:$L$1").AutoFilter Field:=12...

The code appears to hang on this line of code:

Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete (xlShiftUp)

thanks for your help.

 

[jbeaucaire]

I've seen that happen when the filtered sheet shows no rows. When the code halts, what does the sheet show?

 

[FROGGER24]

I see my column labels and column "L" still has the autofilter turned on. Once I deselect column L I see all my data

 

[jbeaucaire]

I see my column labels and column "L" still has the autofilter turned on. Once I deselect column L I see all my data

So when the autofilter is activated, you ONLY see the labels, ALL the data is hidden? If so, it's hanging because the delete command found no data visible.

What do you want to do? If it's hanging because there are NO rows with 0 in that column, we can make the macro skip the next command by testing if there's any visible data by adding this line of code ABOVE that one, like so:

Range("A1").AutoFilter Field:=12, Criteria1:="=0"
If Range("A" & Rows.Count).End(xlUp).Row > 1 Then _
    Range("A2:A" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete (xlShiftUp)
Range("A1").AutoFilter Field:=5, Criteria1:=">=2.5"
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$" & Range("A1").End(xlDown).Row

Does that help?


If not, is there zero values in that column to delete and they're just not being filtered properly? If so, let the macro hang at that point. Reset. Record a macro of you manually filtering the column L by zero and post up that code. Maybe I have the syntax a little off somewhere.