CODEWITHSUNDEEP
excelvba
ggmkp
ggmkp

Reputation: 725

Find Last Row Until Next Highlighted Cell

I'm trying to find a last row until next highlighted cell and clear the range.

Range("B2").End(xlDown) won't work, I found something called xlCellTypeSameFormatConditions under SpecialCells but not sure how this could be applied.

Maybe there is a better method?
The result should clear Range B2:B7 only

enter image description here

Ok so combining both solution into one I have it like this

Private Sub WorkSheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
  If Not Intersect(Target, Range("A1")) Is Nothing Then

  Dim rngCheck, rngCell As Range

  Set rngCheck = ActiveSheet.Range("B2:B" & Cells(2, 2).End(xlDown).Row)
    For Each rngCell In rngCheck
      If rngCell.Interior.Pattern = xlNone Or rngCell.Value = "" Then rngCell.Value = ""
    Next
  Set rngCheck = Nothing

  End If
End Sub

So basically when value in "A1" changes, trigger a clear.
The same code works under Module but not with WorkSheet_Change

Upvotes: 0

Views: 120

Answers (2)

JvdV
JvdV

Reputation: 75840

You could try:

enter image description here

Sub test()

Dim rng As Range

With Application.FindFormat
    .Clear
    .Interior.Color = vbWhite
End With

With ThisWorkbook.Sheets("Sheet1") 'Change to correct sheetname
    Set rng = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
    rng.Cells.Replace What:="*", Replacement:="", SearchFormat:=True
End With

End Sub

enter image description here

If you want to run the code on a sheet change event try the below:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range

Debug.Print Target.Address
Application.EnableEvents = False
If Target.Address = "$A$1" Then
    With Application.FindFormat
        .Clear
        .Interior.Color = vbWhite
    End With
    Set rng = Range("B2:B" & Cells(2, 2).End(xlDown).Row)
    rng.Cells.Replace What:="*", Replacement:="", SearchFormat:=True
End If
Application.EnableEvents = True

End Sub

Upvotes: 1

T4roy
T4roy

Reputation: 196

Try this, note there is no exception or error handling. This will stop as soon as it hits a highlighted cell no matter what colour, and will not remove non-highlighted cells which are between highlighted cells.

Sub MoveToNextHighlightedCell()
  Do Until Not ActiveCell.Interior.Pattern = xlNone Or ActiveCell.Value = ""
    ActiveCell.Value = ""
    ActiveCell.Offset(1, 0).Select
  Loop
End Sub

Alternatively use this, it will not stop unless there are missing values. Updated as per comment from @Mikku.

Sub MoveToNextHighlightedCell()
  Dim rngCheck, rngCell As Range
  Set rngCheck = ActiveSheet.Range(ActiveCell, ActiveCell.End(xlDown))
    For Each rngCell In rngCheck
      If rngCell.Interior.Pattern = xlNone Or rngCell.Value = "" Then rngCell.Value = ""
    Next
  Set rngCheck = Nothing
End Sub

Upvotes: 1

Related Questions