how to merge cells with same value in one row - excel

Question

How do I merge cells with the same value and color in a row?
and the result should be :

Answer 1

I think you could try this:
Option Explicit
Sub test()
Dim LastRow As Long, i As Long, Value As Long
Dim Color As Double
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
Value = .Range("A" & i).Value
Color = .Range("A" & i).Interior.Color
If .Range("A" & i - 1).Value = Value And .Range("A" & i - 1).Interior.Color = Color Then
.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub

Answer 2

Copy Consecutive to One
Adjust the values in the constants section to fit your needs.
The image looks like you want all this to happen in the same column
of the same worksheet, which is adjusted in the constants section.
Before writing to Target Column (cTgtCol), the code will clear its
contents. Be careful not to lose data.
Colors are applied using a loop, which will slow down the fast array approach of copying the data.
The Code
Sub CopyConsecutiveToOne()
' Source
Const cSource As Variant = "Sheet1" ' Worksheet Name/Index
Const cSrcCol As Variant = "A" ' Column Letter/Number
Const cSrcFR As Long = 1 ' Column First Row Number
' Target
Const cTarget As Variant = "Sheet1" ' Worksheet Name/Index
Const cTgtCol As Variant = "A" ' Column Letter/Number
Const cTgtFR As Long = 1 ' Column First Row Number
Dim rng As Range ' Source Column Last Used Cell Range,
' Source Column Range, Target Column Range
Dim vntS As Variant ' Source Array
Dim vntT As Variant ' Target Array
Dim vntC As Variant ' Color Array
Dim i As Long ' Source Range/Array Row/Element Counter
Dim k As Long ' Target/Color Array Element Counter
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'On Error GoTo ProcedureExit
' In Source Worksheet
With ThisWorkbook.Worksheets(cSource).Columns(cSrcCol)
' Calculate Source Column Last Used Cell Range.
Set rng = .Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious)
' Check if data in Source Column.
If Not rng Is Nothing Then ' Data found.
' Calculate Source Range.
Set rng = .Range(.Cells(cSrcFR), .Cells(rng.Row))
' Copy values from Source Range to Source Array.
vntS = rng
Else ' Data Not Found.
With .Cells(1)
MsgBox "No Data in column '" & .Split(.Address, "$")(1) & "'."
GoTo ProcedureExit
End With
End If
End With
' In Arrays
' Count the number of elements in Target/Color Array.
k = 1 ' The first element will be included before the loop.
' Loop through elements of Source Array.
For i = 2 To UBound(vntS)
' Check if current value is different then the previous one.
If vntS(i, 1) <> vntS(i - 1, 1) Then
' Count element of Target/Color Array.
k = k + 1
End If
Next
' Write to Target/Color Arrays
' Resize Target/Color Arrays.
ReDim vntT(1 To k, 1 To 1)
ReDim vntC(1 To k, 1 To 1)
' Reset Counter
k = 1 ' The first element will be included before the loop.
' Write first value from Source Array to Target Array.
vntT(1, 1) = vntS(1, 1)
' Write first color value to Target Color Array.
vntC(1, 1) = rng.Cells(1, 1).Interior.Color
' Loop through elements of Source Array.
For i = 2 To UBound(vntS)
' Check if current value is different then the previous one.
If vntS(i, 1) <> vntS(i - 1, 1) Then
' Count element of Target/Color Array.
k = k + 1
' Write from Source Array to Target Array.
vntT(k, 1) = vntS(i, 1)
' Write color values from Source Range to Color Array.
vntC(k, 1) = rng.Cells(i, 1).Interior.Color
End If
Next
' All necessary data is in Target/Color Arrays.
Erase vntS
Set rng = Nothing
' In Target Worksheet
With ThisWorkbook.Worksheets(cTarget).Cells(cTgtFR, cTgtCol)
' Clear contents of range from Target First Cell to Target Bottom Cell.
.Resize(Rows.Count - .Row + 1).ClearContents
' Calculate Target Column Range.
Set rng = .Resize(k)
' Copy Target Array to Target Range.
rng = vntT
' Apply colors to Target Range.
With rng
' Loop through cells of Target Column Range.
For i = 1 To k
' Apply color to current cell of Target Range using the values
' from Color Array.
.Cells(i, 1).Interior.Color = vntC(i, 1)
Next
End With
End With
ProcedureExit:
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Answer 3

Create a custom function in Visual Basic Editor that will return to the color index of the cell:
Function COLOR(Target As Range)
COLOR = Target.Interior.ColorIndex
End Function
Then in the right column use a formula similar to this:
=IF(OR(A2<>A3,COLOR(A2)<>COLOR(A3)),1,0)
Then filter to show only 1's.