Help with a loop

[Peter]

I am using the following code to delete all rows that do
not contain a 1 in column C. It works on ALL rows in a
worksheet. I need it to only work within a selection
(A2:H128). I can't seem to get anything to work. Any
suggestions? TIA

Dim RowNdx1 As Long
Dim LastRow1 As Long
Sheets("TEST").Select
LastRow1 = ActiveSheet.Cells(Rows.Count, "C").End
(xlUp).Row
For RowNdx1 = LastRow1 To 2 Step -1
With Cells(RowNdx1, "C")
If .Value <> 1 Then
Rows(RowNdx1).Delete
End If
End With
Next RowNdx1

 

[Bob Phillips]

Dim RowNdx1 As Long
Dim LastRow1 As Long
Sheets("TEST").Select
For RowNdx1 = 128 To 2 Step -1
With Cells(RowNdx1, "C")
If .Value <> 1 Then
Rows(RowNdx1).Delete
End If
End With
Next RowNdx1

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Peter]

That worked Bob, thank you for the reply but I guess
that's not what I wanted it to do. Here is what I have:

I have a 3 lists of data in the same columns. The first
list is in rows 2-128, the second in rows 130-256, and the
third in rows 258-384. I would like to delete all rows
between 2 & 128 that do not contain a 1 in column C,
delete all rows between 130 & 256 that do not contain 1.25
in column C, and delete all rows between 258 & 384 that do
not contain 1.5 in column C.

Any advice on this?

 

[chris]

if its just for the Rows 2 - 128 then this

Dim RowNdx1 As Lon
Sheets("TEST").Selec
For RowNdx1 = 128 To 2 Step -
With Cells(RowNdx1, "C"
If .Value <> 1 The
Rows(RowNdx1).Delet
End I
End Wit
Next RowNdx

to check all cells in range do this

Dim i As Long, MyRng as Rang
Sheets("TEST").Selec
For i= 128 To 2 Step -
Set MyRng = Range(Cells(i,1), Cells(i,8)
For each c in MyRn
If c.Value <> 1 The
Rows(i).Delet
Exit Fo
End I
Next
Next


----- Peter wrote: ----

I am using the following code to delete all rows that do
not contain a 1 in column C. It works on ALL rows in a
worksheet. I need it to only work within a selection
(A2:H128). I can't seem to get anything to work. Any
suggestions? TI

Dim RowNdx1 As Lon
Dim LastRow1 As Lon
Sheets("TEST").Selec
LastRow1 = ActiveSheet.Cells(Rows.Count, "C").En
(xlUp).Ro
For RowNdx1 = LastRow1 To 2 Step -
With Cells(RowNdx1, "C"
If .Value <> 1 The
Rows(RowNdx1).Delet
End I
End Wit
Next RowNdx

 

[Bob Phillips]

That is nothing like what you asked for<g>

Is the 2-128, 130-256, and 258-384 fixed rows, or could they vary.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Peter]

Sorry Bob, guess I didn't think it all the way through

yes the rows will be fixed.

Thanks for your reply

 

[Bob Phillips]

Okay, try this

Dim RowNdx1 As Long
Dim LastRow1 As Long
Sheets("TEST").Select

For RowNdx1 = 384 To 258 Step -1
With Cells(RowNdx1, "C")
If .Value <> 1.5 Then
Rows(RowNdx1).Delete
End If
End With
Next RowNdx1

For RowNdx1 = 256 To 130 Step -1
With Cells(RowNdx1, "C")
If .Value <> 1.25 Then
Rows(RowNdx1).Delete
End If
End With
Next RowNdx1

For RowNdx1 = 128 To 2 Step -1
With Cells(RowNdx1, "C")
If .Value <> 1 Then
Rows(RowNdx1).Delete
End If
End With
Next RowNdx1

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Peter]

that was it...thank you very much

-----Original Message-----
Okay, try this

Dim RowNdx1 As Long
Dim LastRow1 As Long
Sheets("TEST").Select

For RowNdx1 = 384 To 258 Step -1
With Cells(RowNdx1, "C")
If .Value <> 1.5 Then
Rows(RowNdx1).Delete
End If
End With
Next RowNdx1

For RowNdx1 = 256 To 130 Step -1
With Cells(RowNdx1, "C")
If .Value <> 1.25 Then
Rows(RowNdx1).Delete
End If
End With
Next RowNdx1

For RowNdx1 = 128 To 2 Step -1
With Cells(RowNdx1, "C")
If .Value <> 1 Then
Rows(RowNdx1).Delete
End If
End With
Next RowNdx1

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)




.

 

[Bob Phillips]

It's a pleasure.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)