PDA

View Full Version : Help Deleting Rows with "If, then" statement



cwb1021
04-03-2017, 05:48 AM
Experts,

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

http://www.vbaexpress.com/forum/showthread.php?59027-Need-help-passing-variable-values-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
04-04-2017, 05:17 PM
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