Find specific value, loop through rows and delete rows.

[Sneaky Pete]

Hey All,

Hope you can help me with this code.
When a user clicks a button, the routine is looking for the second highest value.
In the next step the range is selected, color is set from red tot black, no strikethrough and cells are no longer locked.
This works fine, the routine starts from cell 42 en checks all to the lastrow.

In the same routine I want to delete the rows with the highest value.
Instead of loop through the rows, starting from cell 42 to the lastrow, only the rows of the first Highest value is deleted, the rows below are skipped.

I can't figure it out why, so hope someone can help.
Below is my coee
For Each vcell In Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(42, 3), Worksheets("Sheet1").Cells(Lastrow, 3))
If vcell.Value = SecHighest Then
Set Rng = vcell.Offset(0, -1).Resize(2, 29)
Rng.Font.Color = vbBlack
Rng.Font.Strikethrough = False

If Rng.EntireRow.Group = True Then
Rng.EntireRow.ClearOutline
Else
End If
Rng.Locked = False
End If
Next vcell
End If

'Delete row
For Each vcell In Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(42, 3), Worksheets("Sheet1").Cells(Lastrow, 3))
If vcell.Value = Highest Then
Set Rng = vcell.Offset(0, -1).Resize(2, 29)
Rng.EntireRow.Delete
End If
Next vcell