Delete rows based on colour of cells - excel

Question

At the moment I have some cells that look something like this
What I want to achieve is something that deletes duplicates but also puts all of the green cells into the same row
What I have at the moment is a code like this
Sub Delete_Duplicates()
Worksheets("MySheet").Activate
'Obtain the last row with data on column 2
a = Worksheets("MySheet").Cells(Rows.Count, 2).End(xlUp).Row
'Loop through the name of the items
For b = a To 6 Step -1
CurrentCell = Cells(b, 2).Select
CellValue = Cells(b, 2).Value
CellUp = ActiveCell.Offset(-1, 0)
If ActiveCell.Value = CellUp Then
For c = 8 To 19
If Range(b, c).Interior.Color = RGB(146, 208, 80) Then
Worksheets("MySheet").Range(b, c).Activate
Range(b, c).Copy Destination:=ActiveCell.Offset(-1, 0)
Rows(a).EntireRow.Delete
End If
Next c
End If
Next b
End Sub
What I am hoping that this code does is that it recognises if the value of the active cell is equal to the cell on top and then if their values are equal I loop through the cells from column H to column S and copy the cells that are green and paste them on top
The issue that I have at the moment is that when my code finds two cells with equal names after going to the line
If Range(b, c).Interior.Color = RGB(129, 188, 0) Then
The compiler just skips the rest of the code and wont execute anything else, can anyone help me see why is the rest of my code being skipped?

Answer 1

I m not 100% sure about the code because was to complex but i try to create something:
Sub TEST()
Dim LastRow As Long, i As Long, y As Long, w As Long, k As Long, RowCounter As Long, FirstInstant As Long, o As Long, l As Long
Dim arrNames As Variant, arrNumber(0) As Variant, arrCheck As Variant, arrDelete(0) As Variant, arrColor As Variant, arrSplit As Variant
Dim Found As Boolean, Found_2 As Boolean
RowCounter = 0
FirstInstant = 0
With ThisWorkbook.Worksheets("Sheet2")
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
arrNames = .Range("B6:B" & LastRow)
'Loop name
For i = LBound(arrNames) To UBound(arrNames)
'Loop rows
For y = 6 To LastRow
'Check there is a match
If arrNames(i, 1) = .Range("B" & y).Value Then
If FirstInstant = 0 Then
FirstInstant = y
End If
If RowCounter > 0 Then
If arrDelete(0) = "" Then
arrDelete(0) = y & ":" & y
Else
arrSplit = Split(arrDelete(0), ",")
For l = LBound(arrSplit) To UBound(arrSplit)
If arrSplit(l) = y & ":" & y Then
Found_2 = True
Exit For
End If
Next l
If Found_2 = False Then
arrDelete(0) = arrDelete(0) & "," & y & ":" & y
End If
End If
Else
RowCounter = RowCounter + 1
End If
'Loop columns
For w = 3 To 19
'Check if there is color
If .Cells(y, w).Interior.Color = RGB(129, 188, 0) Then
If arrNumber(0) = "" Then
arrNumber(0) = w
Else
arrCheck = Split(arrNumber(0), ",")
Found = False
'Check if the column already excist
For k = LBound(arrCheck) To UBound(arrCheck)
If arrCheck(k) = w Then
Found = True
Exit For
End If
Next k
If Found = False Then
arrNumber(0) = arrNumber(0) & "," & w
End If
End If
End If
Next w
End If
Next y
'Color
If arrNumber(0) <> "" Then
arrColor = Split(arrNumber(0), ",")
For o = LBound(arrColor) To UBound(arrColor)
.Cells(FirstInstant, CLng(arrColor(o))).Interior.Color = RGB(129, 188, 0)
Next o
End If
RowCounter = 0
FirstInstant = 0
Erase arrNumber
Erase arrCheck
Erase arrColor
Next i
.Range(arrDelete(0)).EntireRow.Delete
End With
End Sub