Help Deleting Rows with "If, then" statement

[cwb1021]

Experts,

This is an extension of a previous post found here. Thanks to all who replied there.

http://www.vbaexpress.com/forum/show...es-to-For-Loop


I have a procedure that uses values from multiple columns in a calculation which populates a new column. All of this is working well, but now after the calculation is performed, I'm trying to copy the entire contents of the worksheet to a new worksheet and delete certain rows after the data has been pasted. The value "ScanRad" is input through a user form, and if the previously calculated value is less than "ScanRad", that entire row is deleted (at least that's my attempt). What I have here works to an extent, but only deleted some of the rows while leaving others that should have been deleted.

Here is the code so far:

Option Explicit
Private Sub CalcDistButton1_Click()
Dim ScanRad As Single
Dim SubLat As Double, SubLon As Double
Dim FilterCell As Range, DataRange As Range, RadCell As Range, FilteredRange As Range
Dim x As Variant, y As Variant, z As Variant
Dim wsFS As Worksheet
Set wsFS = Worksheets("FilteredSet")
'Pull scan radius value from input box
   With Worksheets("sheet1")
     Set DataRange = Range(.Cells(2, 9), .Cells(Rows.Count, 9).End(xlUp)).SpecialCells(xlCellTypeVisible)
   End With
   
   ScanRad = UserForm1.TextBox3.Text
   SubLat = UserForm1.TextBox1.Text
   SubLon = UserForm1.TextBox2.Text
   
'Calculate offset distance for unhidden rows
      For Each FilterCell In DataRange
      
         x = FilterCell.Offset(, 1)
         y = FilterCell.Offset(, 2)
         z = FilterCell.Offset(, 4)
         
         With Application
            
           FilterCell.Offset(, 5) = Application.Acos(Cos(Application.Radians(90 - SubLat)) * Cos(Application.Radians(90 - x)) + Sin(Application.Radians(90 - SubLat)) * _
Sin(Application.Radians(90 - x)) * Cos(Application.Radians(SubLon - y))) * ((z) / 5280)
        
         End With
      
      Next FilterCell
'Copy/Paste values from Sheet 1 to worksheet "FilteredSet"
      Worksheets("sheet1").UsedRange.Copy
      wsFS.Range("A1").Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
 
Set FilteredRange = Intersect(wsFS.Columns(14), wsFS.UsedRange)
   For Each RadCell In FilteredRange
      If IsNumeric(RadCell.Value) And RadCell.Value > ScanRad Then
         RadCell.EntireRow.Delete
      End If
   Next RadCell
End Sub

As you can see from the result, if I input a value of 10 for "ScanRad", on the new worksheets "FilteredSet", 3 rows with a value greater than 10 have been deleted, but 2 still remain.

Also, I've used IsNumeric so that the headers in the "FilteredSet" worksheet are not deleted. This works, but there may be a better way to do this?

And yes, I do have a reason for copying the data to a new worksheet before deleting any rows. I have another piece of code that will first filter the data on sheet 1 before pasting to the new worksheet and I will need to leave this dataset in tact. I just have not merged these parts together yet.

I've also attached the workbook.

Any help is greatly appreciated!

Thanks,

Chris

[Paul_Hossler]

Not sure about what the question actually is, but here's another way to delete the rows

You should delete rows bottom to top, but this also works for things like this

    Set FilteredRange = Intersect(wsFS.Columns(14), wsFS.UsedRange)

   For Each RadCell In FilteredRange
      If IsNumeric(RadCell.Value) And RadCell.Value > ScanRad Then
         RadCell.Value = True
      End If
   Next RadCell

    On Error Resume Next
    FilteredRange.SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
    On Error GoTo 0