Trying to delete rows and it's not working

T

tahrah

I sure do need some help. This is frustrating. I've changed this a
hundred times trying to find the right combination and nothing is
working. I'm trying to "delete" all rows where any cell in Column A is
emtpy, Column C is empty, Column A says SO NUMBER, Column C says LOG
DETAIL, Column B says ---. Here is my macro below and I've put a
<<<<<<<<<< by the code I thought would do the trick. Can anyone help?


Sub Backlog_By_Product_Number()
Dim lngRow As Long
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft

Rows("1:2001").Sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
lngRow = Range("A2001").End(xlUp).Row + 1 <<<<<<<<<<
Rows(lngRow & ":2001").Select <<<<<<<<<<
Selection.Delete Shift:=xlUp = True <<<<<<<<<<
lngRow = Range("C2001").End(xlUp).Row + 1 <<<<<<<<<<
Rows(lngRow & ":2001").Select <<<<<<<<<<
Selection.Delete Shift:=xlUp = True <<<<<<<<<<
For Each rngCell In Range("A1", Cells(lngRow - 1, "A"))
<<<<<<<<<<
If rngCell.Value = "SO NUMBER" Then <<<<<<<<<<
rngCell.EntireRow.Select <<<<<<<<<<
Selection.Delete Shift:=xlUp = True <<<<<<<<<<
End If <<<<<<<<<<
Next 'rngCell <<<<<<<<<<
For Each rngCell In Range("C1", Cells(lngRow - 1, "C"))
<<<<<<<<<<
If rngCell.Value = "LOG DETAIL" Then <<<<<<<<<<
rngCell.EntireRow.Select <<<<<<<<<<
Selection.Delete Shift:=xlUp = True <<<<<<<<<<
End If <<<<<<<<<<
Next 'rngCell <<<<<<<<<<
For Each rngCell In Range("B1", Cells(lngRow - 1, "B"))
<<<<<<<<<<
If rngCell.Value = "'---" Then <<<<<<<<<<
rngCell.EntireRow.Select <<<<<<<<<<
Selection.Delete Shift:=xlUp = True <<<<<<<<<<
End If <<<<<<<<<<
Next 'rngCell <<<<<<<<<<
Rows("1:2001").Sort Key1:=Range("C1"), Order1:=xlAscending,
_
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "S.O. NO."
Range("B1").Select
ActiveCell.FormulaR1C1 = "LINE #"
Range("C1").Select
ActiveCell.FormulaR1C1 = "P/N"
Range("D1").Select
ActiveCell.FormulaR1C1 = "DUE DATE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "QTY"
Range("F1").Select
ActiveCell.FormulaR1C1 = "UNIT PRICE"
Range("G1").Select
ActiveCell.FormulaR1C1 = "TOTAL"
Columns("F:G").Select
Selection.NumberFormat = "$#,##0.00"
Rows("1:2001").Sort Key1:=Range("C1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
ActiveSheet.PageSetup.PrintArea = Rows("4:" & lngRow - 1).Address
'?
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = "PAGE NO. &P"
.CenterHeader = "BACKLOG Sorted By Product Number"
.RightHeader = "&D, &T"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 15
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Rows("2:2002").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("A2").Select
End Sub
 
T

tahrah

Here's the code again without the <<<<<<<<<:

lngRow = Range("A2001").End(xlUp).Row + 1
Rows(lngRow & ":2001").Select
Selection.Delete Shift:=xlUp = True
lngRow = Range("C2001").End(xlUp).Row + 1
Rows(lngRow & ":2001").Select
Selection.Delete Shift:=xlUp = True
For Each rngCell In Range("A1", Cells(lngRow - 1, "A"))
If rngCell.Value = "SO NUMBER" Then
rngCell.EntireRow.Select
Selection.Delete Shift:=xlUp = True
End If
Next 'rngCell
For Each rngCell In Range("C1", Cells(lngRow - 1, "C"))
If rngCell.Value = "LOG DETAIL" Then
rngCell.EntireRow.Select
Selection.Delete Shift:=xlUp = True
End If
Next 'rngCell
For Each rngCell In Range("B1", Cells(lngRow - 1, "B"))
If rngCell.Value = "'---" Then
rngCell.EntireRow.Select
Selection.Delete Shift:=xlUp = True
End If
Next 'rngCell
 
M

Martin Fishlock

This will do the deleting.

Not sure about the bits at the start. Save your data first.

Sub deleterowsasneeded()
Dim lngRow As Long, lngLastRow As Long
Dim bRowDelete As Boolean
With ActiveSheet.UsedRange
lngLastRow = .Row + .Rows.Count + 1
End With
Rows(lngRow + 1 & ":" & Cells.Rows.Count).Delete ' clear to end

For lngRow = lngLastRow To 1 Step -1 ' work backwards
bRowDelete = False ' flag for deleting
' check the values
If Trim(Cells(lngRow, 1).Value) = "" Then
bRowDelete = True
ElseIf Trim(UCase(Cells(lngRow, 1).Value)) = "SO NUMBER" Then
bRowDelete = True
ElseIf Trim(Cells(lngRow, 2).Value) = "---" Then
bRowDelete = True
ElseIf Trim(Cells(lngRow, 3).Value) = "" Then
bRowDelete = True
ElseIf Trim(UCase(Cells(lngRow, 3).Value)) = "LOG DETAIL" Then
bRowDelete = True
End If
If bRowDelete = True Then Rows(lngRow).Delete
Next lngRow
End Sub
 
T

tahrah

Martin, Thanks. It calculated for a looooooooong time and ended up
deleting ALL rows. Then it added the column titles, then it hung up
and got stuck on the print area section. Here's the macro with the new
code you provided. Did I do something wrong?

Sub Backlog_By_Product_Number()

Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft

Dim lngRow As Long, lngLastRow As Long
Dim bRowDelete As Boolean
With ActiveSheet.UsedRange
lngLastRow = .Row + .Rows.Count + 1
End With
Rows(lngRow + 1 & ":" & Cells.Rows.Count).Delete ' clear to end


For lngRow = lngLastRow To 1 Step -1 ' work backwards
bRowDelete = False ' flag for deleting
' check the values
If Trim(Cells(lngRow, 1).Value) = "" Then
bRowDelete = True
ElseIf Trim(UCase(Cells(lngRow, 1).Value)) = "SO NUMBER" Then
bRowDelete = True
ElseIf Trim(Cells(lngRow, 2).Value) = "---" Then
bRowDelete = True
ElseIf Trim(Cells(lngRow, 3).Value) = "" Then
bRowDelete = True
ElseIf Trim(UCase(Cells(lngRow, 3).Value)) = "LOG DETAIL" Then
bRowDelete = True
End If
If bRowDelete = True Then Rows(lngRow).Delete
Next lngRow

Rows("1:2001").Sort Key1:=Range("C1"), Order1:=xlAscending,
Key2:=Range("D1"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "S.O. NO."
Range("B1").Select
ActiveCell.FormulaR1C1 = "LINE #"
Range("C1").Select
ActiveCell.FormulaR1C1 = "P/N"
Range("D1").Select
ActiveCell.FormulaR1C1 = "DUE DATE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "QTY"
Range("F1").Select
ActiveCell.FormulaR1C1 = "UNIT PRICE"
Range("G1").Select
ActiveCell.FormulaR1C1 = "TOTAL"
Columns("F:G").Select
Selection.NumberFormat = "$#,##0.00"
Rows("1:1").Select
Selection.Font.bold = True
ActiveSheet.PageSetup.PrintArea = Rows("1:" & lngRow - 1).Address
'?
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = "PAGE NO. &P"
.CenterHeader = "BACKLOG Sorted By Product Number"
.RightHeader = "&D, &T"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 15
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Rows("2:2002").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending,
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("A2").Select
End Sub
 
M

Martin Fishlock

Try this:

Sub Backlog_By_Product_Number()
'delete columns backwards so do not overdelete
Columns("I:I").Delete
Columns("G:G").Delete
Columns("B:D").Delete

Dim lngRow As Long, lngLastRow As Long
Dim bRowDelete As Boolean
With ActiveSheet.UsedRange
lngLastRow = .Row + .Rows.Count - 1
End With
' corrected this to lnglasteow
Rows(lngLastRow + 1 & ":" & Cells.Rows.Count).Delete ' clear to end
'
For lngRow = lngLastRow To 1 Step -1 ' work backwards
bRowDelete = False ' flag for deleting
' check the values
If Trim(Cells(lngRow, 1).Value) = "" Then
bRowDelete = True
ElseIf Trim(UCase(Cells(lngRow, 1).Value)) = "SO NUMBER" Then
bRowDelete = True
ElseIf Trim(Cells(lngRow, 2).Value) = "---" Then
bRowDelete = True
ElseIf Trim(Cells(lngRow, 3).Value) = "" Then
bRowDelete = True
ElseIf Trim(UCase(Cells(lngRow, 3).Value)) = "LOG DETAIL" Then
bRowDelete = True
End If
If bRowDelete = True Then Rows(lngRow).Delete
Next lngRow

Rows("1:1").Insert
Range("A1:G1") = Array("S.O. NO.", "LINE #", _
"P/N", "DUE DATE", "QTY", "UNIT PRICE", "TOTAL")
Columns("F:G").NumberFormat = "$#,##0.00"
Rows("1:1").Font.Bold = True

ActiveSheet.UsedRange.Sort Key1:=Range("C1"), Order1:=xlAscending, _
Key2:=Range("D1"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address
'?
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = "PAGE NO. &P"
.CenterHeader = "BACKLOG Sorted By Product Number"
.RightHeader = "&D, &T"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 15
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveSheet.PrintOut Copies:=1, Collate:=True
Range("A2").Select
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Code to sort rows getting hung up by merged cells 0
Runtime error 1004 Application-defined or object defined error" on data sort 1
Macros the same but not acting the same 0
SpecialCells(xlCellTypeBlanks) = error 1004 No cells found 5
Trying to hide all rows where no data is in columns AQ-AV 2
Simple Do... Until problem 4
Sort in hidden page crach 8
VB Printing problem 0

Top