R
Ryan Hess
Currently I have a macro that searches column A row 9+ for a numeric value.
If no value is found in column A of that row, the row is deleted and all
other rows move up. The macro does this function just fine. The problem is,
it shrinks the print window when it deletes all these rows. Is there a way
to edit this macro so that it still deletes all the rows with nothing in
column A, still moves all rows with a value in column A up BUT does not
shrink the print window?
Code I currently use:
Sub CleanUp()
Dim wS1 As Worksheet
Dim DeleteValue As String
Dim rng As Range
Dim calcmode As Long
Set wS1 = Workbooks("Order Form.xls").Sheets("Order Form")
wS1.Unprotect Password:="xxxxx"
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
DeleteValue = ""
With ActiveSheet
.AutoFilterMode = False
.Range("A9:A" & .Rows.Count).AutoFilter Field:=1,
Criteria1:=DeleteValue
With .AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With
.AutoFilterMode = False
End With
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
wS1.Protect Password:="xxxxx"
ActiveSheet.Range("A10").Select
End Sub
Thank you!
If no value is found in column A of that row, the row is deleted and all
other rows move up. The macro does this function just fine. The problem is,
it shrinks the print window when it deletes all these rows. Is there a way
to edit this macro so that it still deletes all the rows with nothing in
column A, still moves all rows with a value in column A up BUT does not
shrink the print window?
Code I currently use:
Sub CleanUp()
Dim wS1 As Worksheet
Dim DeleteValue As String
Dim rng As Range
Dim calcmode As Long
Set wS1 = Workbooks("Order Form.xls").Sheets("Order Form")
wS1.Unprotect Password:="xxxxx"
With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
DeleteValue = ""
With ActiveSheet
.AutoFilterMode = False
.Range("A9:A" & .Rows.Count).AutoFilter Field:=1,
Criteria1:=DeleteValue
With .AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With
.AutoFilterMode = False
End With
With Application
.ScreenUpdating = True
.Calculation = calcmode
End With
wS1.Protect Password:="xxxxx"
ActiveSheet.Range("A10").Select
End Sub
Thank you!