VBA - Creating a "Color Check Range" to Reverse Loop - excel

Question

Currently have a reverse loop looking for cells.font.strikethrough = true
Once found, I'm using that cell as a starting point for my .find to find the first cell above that has an Interior. Color = RGB(0,0,0) and copy/pasting that value to the destination first, then offsetting the cell that has a strikethrough by a column and deleting this entire row of data.
For the sake of my awful communication lately:
Parent cell = black background
Child cell = Every cell below the parent that does not have a black background
The cells with a black background can never have a strikethrough/be deleted at the same time as some of the child cells, because not all child cells will be moved to the other worksheet at the same time.
Data populates to this workbook like so:
Parent
child
child
child
Parent
child
child
child
child
child
etc. the # of child cells are unknown for each parent.
Taking the example above, when all child cells have been moved/deleted for both parents this results in the 2 parents located above/below one another with no way to remove them other than manually deleting the rows. Like so:
Parent
Parent
Leading me to my question of wanting a "parent cell color check" of sorts
Summary:
While reverse loop searches for strikethroughs, the macro will eventually cross a cell with a black background
Once that happens, check above that cell for another black background, and continue checking above until it hits a cell without a black background, then I want to delete all consecutive black background rows.
The only immediate problem I can think of this situation:
Parent
Parent
Parent
Child (no strikethrough)
I think the above logic would end up deleting the parent of the child that has yet to be removed, which I don't want and I'm not sure how to prevent.
Child cells will always be located below the parents, so maybe another bit of code checking above and below the first parent to see if child exists, if no child then use that position as the starting range for the parent check? I have no idea, my brain is hurting and this is due in two days!
Apologies for the long rambling! Here's what I'm working with right now.
Private Sub CommandButton1_Click()
Dim ipWS As Worksheet, compWS As Worksheet
Dim compDest As Range, rrCell As Range
Dim i As Integer
Dim alastRow As Long
Set ipWS = ThisWorkbook.Worksheets("In Processing")
Set compWS = ThisWorkbook.Worksheets("Completed")
alastRow = ipWS.Cells(Rows.Count, 1).End(xlUp).Row
Dim rackRng As Range
Dim cellRng As Range
Set compDest = compWS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Application.FindFormat.Interior.Color = RGB(0, 0, 0)
For i = alastRow To 1 Step -1
If Range(Cells(i, 1), Cells(i, 1)).Font.Strikethrough = True Then
Set rackRng = ipWS.Range(Cells(i, 1), Cells(i, 1).End(xlUp)).Find("*", , , , , xlPrevious, , , SearchFormat:=True)
rackRng.Copy compDest
Application.CutCopyMode = False
Range(Cells(i, 1), Cells(i, Columns.Count).End(xlToLeft)).Copy compDest.Offset(0, 1)
Application.CutCopyMode = False
Set compDest = compDest.Offset(1, 0)
Range(Cells(i, 1), Cells(i, 1)).EntireRow.Delete
End If
Next i
With compWS.Range("A:P")
.Font.Strikethrough = False
.ColumnWidth = 25
.Font.Size = 14
.WrapText = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlVAlignCenter
End With
End Sub
UPDATE
This picture shows the strikethrough cells being "completed", thus needing to be transferred to the "Completed" worksheet.
With my current code programmed to the button, this is the result on the "Completed" worksheet.
Leaving the "In Processing" sheet looking like the picture below.
Because all child cells for "12/3/2020 110" and "12/3/2020 96" have been removed, I'm looking for a way to add code to the button that removes the 2 parent cells (only when ALL child cells have been moved to the "Completed" worksheet)

Answer 1

Copy and Delete With Format Criteria
The Code
Option Explicit
Sub updateData()
Const ProcName As String = "updateData"
On Error GoTo clearError
' Source
Const srcName As String = "In Processing"
Const srcFirst As String = "D10"
' Destination
Const dstName As String = "Completed"
' Workbook
Dim wb As Workbook
Set wb = ThisWorkbook
' Define Source First Cell.
Dim cel As Range
Set cel = wb.Worksheets(srcName).Range(srcFirst)
' Define Source Range assuming data is contiguous with an empty column
' to the right, and an empty row at the bottom. Data adjacent
' to the left and to the top is allowed.
Dim rng As Range
With cel.CurrentRegion
Set rng = cel.Resize(.Rows.Count + .Row - cel.Row, _
.Columns.Count + .Column - cel.Column)
End With
Dim CopyList As Object
Set CopyList = CreateObject("System.Collections.ArrayList")
Dim DeleteList As Object
Set DeleteList = CreateObject("System.Collections.ArrayList")
Dim i As Long ' Source Counter
Dim cCount As Long ' Copy Counter
Dim dCount As Long ' Delete Counter
Dim iCopied As Boolean ' Interior Color Row Copied
Dim iRow As Long ' Interior Color Row
Dim sRow As Long ' Strike Through Row
' Write the row numbers of the rows to be copied and/or deleted
' to the array lists.
iRow = -1 ' Necessary for the second 'If' statement's logic to work.
For Each cel In rng.Columns(1).Cells
i = i + 1
If cel.Interior.Color = RGB(0, 0, 0) Then
If i - sRow - 1 = iRow Then
dCount = dCount + 1
DeleteList.Add iRow
End If
iRow = i
sRow = 0
iCopied = False
ElseIf cel.Font.Strikethrough Then
If Not iCopied Then
cCount = cCount + 1
CopyList.Add iRow
iCopied = True
End If
cCount = cCount + 1
dCount = dCount + 1
CopyList.Add i
DeleteList.Add i
sRow = sRow + 1
End If
Next cel
If cCount > 0 Then
Application.ScreenUpdating = False
Dim CopyRange As Range ' ByRef
Dim DeleteRange As Range ' ByRef
Dim RowNumber As Variant ' Has to be 'Variant'.
' Write to Destination Worksheet.
For Each RowNumber In CopyList
buildRange CopyRange, rng.Rows(RowNumber)
Next RowNumber
With wb.Worksheets(dstName)
CopyRange.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 1)
With .Range("A:P")
.Font.Strikethrough = False
.ColumnWidth = 25
.Font.Size = 14
.WrapText = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlVAlignCenter
End With
End With
' Delete rows in Source Worksheet.
DeleteList.Sort
For Each RowNumber In DeleteList
buildRange DeleteRange, rng.Columns(1).Cells(RowNumber)
Next RowNumber
DeleteRange.EntireRow.Delete
Application.ScreenUpdating = True
MsgBox "Number of copied rows: " & cCount & vbLf _
& "Number of deleted rows: " & dCount, vbInformation, "Update"
Else
MsgBox "No rows deleted.", vbInformation, "Update"
End If
ProcExit:
Exit Sub
clearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Sub
Sub buildRange( _
ByRef BuiltRange As Range, _
AddRange As Range)
If Not AddRange Is Nothing Then
If Not BuiltRange Is Nothing Then
Set BuiltRange = Union(BuiltRange, AddRange)
Else
Set BuiltRange = AddRange
End If
End If
End Sub