Search column bottom up then delete rows based on value found

[jaslake]

I've attached a dummy worksheet that shows constant values of 1.00 in columns D and E. In the actual workbook, user action will sometimes cause these values to change to something other that 1.00. The user may wish to delete the action that caused the change.

I need a macro that will search from the last cell in column D upward to the first instance of a cell that is not equal to 1.00 and select that cell and those immediately above with the same value as the first found cell.

For example, in the attached worksheet the search would start in the last cell of Columd D and search upward. It would find cell D23 and upward to D19. These entire rows would be deleted.

I'm drawing a blank today on how to approach this. Any help would be appreciated.

Thanks J

[Leith Ross]

Hello Jaslake,

This macro, along with a button to call it, have been added to the attached workbook.

Sub DeleteRows()

  Dim Cell As Range
  Dim Rng As Range
  
    Set Rng = Worksheets("Sheet1").Range("D6:D33")
      For Each Cell In Rng
        If Cell.Value <> 1 Then Cell = ""
      Next Cell
    
    On Error Resume Next
      Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

[jaslake]

Almost does what I want. Except that the macro deletes ALL instances of rows that are not equal to 1.00. It should be deleting only the last instance (and it's shared values, in my example 14.00).

I'll play with it and see what I can do.

Thanks for your help. J

[jaslake]

I just stepped through the macro and it's searching from the top down. I wish to search from the bottom up and select the last instance of the "not 1.00" scenario.

Any suggestions?

Thanks J

[Leith Ross]

Hello jaslake,

Easy enough to change...

Sub DeleteRows()

  Dim R As Long
  Dim Rng As Range
  Dim Test As Variant
  
    Set Rng = Worksheets("Sheet1").Range("D6:D33")
 
    For R = Rng.Rows.Count To 1 Step -1
      Test = Rng.Cells(R, 1).Value
        If Test <> 1 Then
          Do
            Rng.Cells(R, 1) = ""
            R = R - 1
          Loop While Rng.Cells(R, 1) = Test And R <> 0
          Exit For
        End If
    Next R
    
    On Error Resume Next
    Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

[jaslake]

Perfect!

Thanks Leith. J