Delete Rows

[jmenche]

Alright!! I've tried to duplicate a couple of different methods (from this site) about how to delete rows using the Union method and it still doesn't work!!!

Can someone look at the "Exclude" case and tell me what I'm doing wrong??

:banghead:


Sub RevisedRanks()
Dim ws As Worksheet
Dim LastRow As Long
Dim Cel As Range, DelRange As Range
Dim C As String
Set ws = Sheets("Item Ranks")
LastRow = ws.Range("b65536").End(xlUp).Row
For Each Cel In ws.Range("O12:O" & LastRow)
Select Case Cel.Value
Case "Drop"
Range(Cel.Row & ":" & Cel.Row).Font.ColorIndex = 3
Range(Cel.Row & ":" & Cel.Row).Font.Strikethrough = True
Case "Add"
Range(Cel.Row & ":" & Cel.Row).Font.ColorIndex = 10
Case "Exclude"
If DelRange Is Nothing Then
Set DelRange = Cells(ActiveCell.Row, ActiveCell.Column)
Else
Set DelRange = Union(DelRange, Cells(ActiveCell.Row, ActiveCell.Column))
End If
End Select
If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
Next

[Bob Phillips]

Couple of things, you need to use Cel in the loop, not Activecell, and delete gets done outside of the loop not inside


Sub RevisedRanks()
Dim ws As Worksheet
Dim LastRow As Long
Dim Cel As Range, DelRange As Range
Dim C As String
Set ws = Sheets("Item Ranks")
LastRow = ws.Range("b65536").End(xlUp).Row
For Each Cel In ws.Range("O12:O" & LastRow)
Select Case Cel.Value
Case "Drop"
Range(Cel.Row & ":" & Cel.Row).Font.ColorIndex = 3
Range(Cel.Row & ":" & Cel.Row).Font.Strikethrough = True
Case "Add"
Range(Cel.Row & ":" & Cel.Row).Font.ColorIndex = 10
Case "Exclude"
If DelRange Is Nothing Then
Set DelRange = Cel
Else
Set DelRange = Union(DelRange, Cel)
End If
End Select
Next
If Not DelRange Is Nothing Then DelRange.EntireRow.Delete
End Sub

[jmenche]

woohoo! thank xld!

[Bob Phillips]

BTW, this


Range(Cel.Row & ":" & Cel.Row)

can be reduced to


Cel.EntireRow