Looping down a Range to delete entire row

[sportsguy]

I did this loop and changed the color of the active cell,
now i want to delete the row of the active cell when matched up.


Code
-------------------

Public Sub DeleteRegions()

Dim anyRegion As String, myRegion As String
Dim anyRange As Range
Dim anyCell As Range
Dim iCnt As Long
Dim iCount As Long

anyRegion = Sheet3.KeptRegion

Sheets("ESSR").Activate
Range("A18").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Cells.Interior.ColorIndex = 19

iCnt = 0

For Each anyCell In Selection
If Not IsEmpty(anyCell) Then
iCnt = iCnt + 1
End If
Next

Range("A18").Select


For iCount = 0 To iCnt
Range("A18").Select
ActiveCell.Offset(rowOffset:=iCount).Activate

myRegion = ActiveCell.Value

If myRegion <> anyRegion Then
ActiveCell.EntireRow.Delete
End If
Next

End Sub

-------------------


thanks in advance

sportsgu

 

[sportsguy]

Thanks

but i don't want an addin as my solution.

this needs to work on multiple machines on multiple
workbooks on multiple sheets. . .

the select row of the active cell is the problem,
any help on that one line?

thanks

sportsguy

 

[sportsguy]

I was tired and it was late when I was initially working on this
and i posted

here is the code for a conditional row delete
after determining the length of continuous rows
in a column to search
with a selection criteria passed from a drop down box
and the sheet name passed from a CALL function in a class module.


Code:
--------------------

Option Explicit

Public anyRegion As String
Public myRegion As String
Public anyRange As Range
Public anyCell As Range
Public iCnt As Long
Public iCount As Long
Public anySheet As String
Public anyPath As String
Public anyName As String
Public savename As String

Sub DeleteRegions(ByVal anySheet As String)

Application.ScreenUpdating = False

' Get Validation criteria for keeping rows from combobox
anyRegion = Sheet3.KeptRegion

Worksheets(anySheet).Activate
Range("A18").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select

' Count rows to evaluate
iCnt = 0

For Each anyCell In Selection
If Not IsEmpty(anyCell) Then
iCnt = iCnt + 1
End If
Next

For iCount = 0 To iCnt
Range("A18").Select
ActiveCell.Offset(rowOffset:=iCount).Activate

' Evaluate for going beyond end of range.
If IsEmpty(ActiveCell) Then
Exit For
Else
myRegion = ActiveCell.Value
End If

' Evaluate cell for row deletion
If myRegion <> anyRegion Then
Selection.Cells.Interior.ColorIndex = 20 'color code delete selection for easy validation of missed deleted rows.

ActiveCell.Rows("1:1").EntireRow.Delete
iCount = iCount - 1 ' reduce loop count for deleted row
iCnt = iCnt - 1 ' reduce offset row count for deleted row
End If
Next iCount

Range("A1").Activate

Application.ScreenUpdating = True

End Sub