Удалить все строки (кроме строки 1) до «TH Value»

Question

То, что я пытаюсь сделать, это удалить все строки, прежде чем зеленое выделение «TH Value».

Я попробовал почти все с очень небольшим успехом. Мне определенно нужна помощь.

Sub Search_Range_For_Text()
Dim cell As Range

    For Each cell In Range("b1:b100")
        If InStr(1, cell.Value, "After Upd") > 0 Then
            cell.Offset(0, 0).Value = "TH Value"
            cell.Interior.ColorIndex = 4

            MsgBox "Scroll down to find TH Value which is highlighted green.  Check field notes to verify if there was a check shot"
        Exit For
      End If

Next cell

End Sub

Это изображение представляет результат, которого я пытаюсь достичь:

Answer 1

Так что это решило проблему, я думаю.

Как только я заблокировал «Если ячейка не является ничем», он начал работать.

Sub DeleteBelow () Dim cell As Range '// Установить формат поиска: зеленый цвет с Application.FindFormat. Interior .Color = RGB (0, 255, 0) '// зеленый цвет Окончание с // // Установить' SearchFormat = True 'для использования FindFormat Set cell = Range ("B: B"). Find (What: = "* ", SearchFormat: = True) 'Если ячейка не пуста, то ' Заблокирована эта инструкция If cell.Row> 2 Then '// Удалить все строки под найденной ячейкой (вплоть до последней строки листа) Rows ( "2:" & cell.Row - 1). Удалить еще MsgBox "Ячейка не найдена.", VbExclamation End If

End Sub

Answer 2

Sub DeleteBelow()
    Dim cell As Range
    '// Set find format: green color
    With Application.FindFormat.Interior
        .Color = RGB(0, 255, 0) '//green color
    End With
    '// Set 'SearchFormat = True' to use FindFormat
    Set cell = Range("B:B").Find(What:="*", SearchFormat:=True)
    If Not cell Is Nothing Then
        If cell.Row > 2 Then
            '// Delete all rows beneath found cell (down to the last sheet row)
            Rows("2:" & cell.Row - 1).Delete
    Else
        MsgBox "No cell was found.", vbExclamation
    End If
End Sub