Right now I have a code that creates a range starting at a specific, user-defined cell. I am currently defining the end of the range by the next cell that has any text in it, as such:

topRowDelete = pnRange.Find(deletePartNumber, LookIn:=xlValues, LookAt:=xlWhole).Row

This defines the top row to be deleted by finding the cell that matches deletePartNumber, which is a defined by user input. The bottom row to delete is then defined by:

btmRowDelete = pnRange.Find(What:="*", LookIn:=xlValues, SearchDirection:=xlNext).Row - 1

This finds the next row with a non-blank cell, then offsets it by one. Now I know the top and bottom rows of the range to delete, so I can simply redefine the range and delete as follows:

Set pnRange = Rows(topRowDelete & ":" & btmRowDelete)
pnRange.Delete

Works like a charm.

The problem is that the btmRowDelete definition only works if the user has input text in one of the cells below. In practice, they should have done this. But it is not always the case. So then the btmRowDelete might be defined incorrectly if the user has not filled in all of the cells as they should.

However, I do know for certain that the next cell that should define btmRowDelete will always be a specific fill color, which is different from the cells in between. Is there a way to modify the .Find command to find the next cell in the range with a specific fill color, instead of the next one that contains text?

CodePudding user response：

Next Cell With a Different Color

• I don't know exactly what your data looks like, but IMO, using the Find method, to get the bottom cell, might not apply i.e. it might work until it doesn't, for the reasons explained in the comments.
• The following applies only to a single-column range.

Utilization

Sub DeletePartNumberTEST()
    ' The 'Debug.Print' lines show how the range changes when rows are deleted.
    
    Dim PartNumber As String: PartNumber = 1
    
    Dim pnRange As Range: Set pnRange = Sheet1.Range("A1:A20")
    Debug.Print "Before Deletion: " & pnRange.Address
    
    DeletePartNumber pnRange, PartNumber
    Debug.Print "After Deletion: " & pnRange.Address

End Sub

The Method

Sub DeletePartNumber( _
        ByVal PartNumberRange As Range, _
        ByVal PartNumber As String)
    Const PROC_TITLE As String = "Delete Part Number"
    
    Dim tCell As Range, rCount As Long
    
    With PartNumberRange
        
        ' Reference the top cell.
        
        Set tCell = .Find(What:=PartNumber, _
            After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole)
        
        If tCell Is Nothing Then
            MsgBox "Part number '" & PartNumber & "' not found.", _
                vbExclamation, PROC_TITLE
            Exit Sub
        End If
        
        ' Calculate the number of rows of the search range.
        rCount = .Rows.Count   .Row - 1 - tCell.Row
        
    End With

    ' Check if it is the last cell of the range (should never happen).
    If rCount = 0 Then
        MsgBox "The part number is in the last row of the range.", _
           vbCritical, PROC_TITLE
        Exit Sub
    End If

    ' Retrieve the color of the top cell.
    Dim tColor As Long: tColor = tCell.Interior.Color
    ' For the color of the cell below instead you can use:
    'Dim tColor As Long: tColor = tCell.Offset(1).Interior.Color
    
    ' Reference the next cell with a different color, the bottom cell.
    
    Dim bCell As Range
    
    For Each bCell In tCell.Offset(1).Resize(rCount).Cells
        If bCell.Interior.Color <> tColor Then Exit For
    Next bCell
    
    If bCell Is Nothing Then
        MsgBox "Part number '" & PartNumber _
            & "' last row not found.", vbExclamation, PROC_TITLE
        Exit Sub
    End If
             
    ' Delete the entire rows from the top to the bottom cells.
    With tCell
        .Resize(bCell.Row - .Row   1).EntireRow.Delete
    End With
    
End Sub

CodePudding user response：

Sub DeletePartNumber( _ ByVal PartNumberRange As Range, _ ByVal PartNumber As String) Const PROC_TITLE As String = "Delete Part Number"

Dim tCell As Range, rCount As Long

With PartNumberRange
    
    ' Reference the top cell.
    
    Set tCell = .Find(What:=PartNumber, _
        After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole)
    
    If tCell Is Nothing Then
        MsgBox "Part number '" & PartNumber & "' not found.", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Calculate the number of rows of the search range.
    rCount = .Rows.Count   .Row - 1 - tCell.Row
    
End With

' Check if it is the last cell of the range (should never happen).
If rCount = 0 Then
    MsgBox "The part number is in the last row of the range.", _
       vbCritical, PROC_TITLE
    Exit Sub
End If

' Retrieve the color of the top cell.
Dim tColor As Long: tColor = tCell.Interior.Color
' For the color of the cell below instead you can use:
'Dim tColor As Long: tColor = tCell.Offset(1).Interior.Color

' Reference the next cell with a different color, the bottom cell.

Dim bCell As Range

For Each bCell In tCell.Offset(1).Resize(rCount).Cells
    If bCell.Interior.Color <> tColor Then Exit For
Next bCell

If bCell Is Nothing Then
    MsgBox "Part number '" & PartNumber _
        & "' last row not found.", vbExclamation, PROC_TITLE
    Exit Sub
End If
         
' Delete the entire rows from the top to the bottom cells.
With tCell
    .Resize(bCell.Row - .Row   1).EntireRow.Delete
End With

End Sub