VBA Merge cells based on Different Cell Colors in the same Row

[Slamdunkromeo]

Hi,

I am trying to merge cells in a row, based on the cell color using VBA.

Example:
A1 = Green
B1 = Green
C1 = Green
D1 = Blanco
E1 = blanco
F1 = Pink
G1 = Pink
etc..

I would like the cells A1:C1 merged. Skip D1:E1. And Merge F1:G1

The cell and the colors are not fixed, so the merge macro should be flexibel.

Second, i would like to place a value in the merged cell (again flexibel position as above) and input the merged cell with a kind of VLOOKUP ( lookup value is one cell below the merged cell. Lookup tabel is a fixed location)

for the first part 1st tried this macro:
Sub Macro2merge()
'
' Macro2merge Macro
'
For Each cell In Range("A1:O1")
Select Case cell.Interior.ColorIndex
Case Is = 4
Selection.Merge
Case Is = 7
Selection.Merge
End Select
Next cell
End Sub

By the definition of the Range, the macro merges all cell A1:O1 into one cell.

Looking forward to receive any help on this.

 

[Slamdunkromeo]

Can anyone help me with this? or is this not possible ?? I spend a lot of time in this already and getting frustraded. If you can help me, please....
I would be very very thankfull !!

 

[mikerickson]

Something like this should work. Merged cells are evil, so this uses CenterAcrossSelection instead of merging the cells.

Sub Macro1()
    Dim i As Long
    Dim sameRange As Range
    
    With Rows(1)
        .Cells.HorizontalAlignment = xlGeneral
        Set sameRange = .Cells(1, 1)
        
        For i = 1 To Application.Intersect(.Parent.UsedRange, .Cells).Columns.Count
                If .Cells(1, i).Interior.ColorIndex = sameRange.Cells(1, 1).Interior.ColorIndex Then
                    Set sameRange = Range(sameRange, .Cells(1, i))
                Else
                    If sameRange.Cells(1, 1).Interior.ColorIndex <> xlNone Then
                        sameRange.HorizontalAlignment = xlCenterAcrossSelection
                        sameRange.Cells(1, 1).Value = "some value"
                    End If
                    Set sameRange = .Cells(1, i)
                End If
        Next i
    End With
    
    If sameRange.Cells(1, 1).Interior.ColorIndex <> xlNone Then
        sameRange.HorizontalAlignment = xlCenterAcrossSelection
        sameRange.Cells(1, 1).Value = "some value"
    End If
    
End Sub

I don't understand what you mean by "i would like to place a value in the cell and input the cell with a kind of VLOOKUP"
Either a cell holds a value or a VLOOKUP formula, it can't contain both.

 

[Slamdunkromeo]

Wow, you got it !! It works perfect. Never would have found this one. Thank you very Much mikerickson !
( i really got a big smile )

One smal addition, The macro is for one row ( as my example ). What do i need to change in the macro to have this for multiple rows.
Selected rows or total sheet. ( which one is easier )

My question on the VLOOKUP is now easier to explain.

In the macro, input in the "centered" cellrange is "some Value"

sameRange.Cells(1, 1).Value = "some value"

The "some value" should be a VLOOKUP.
For examlpe:
lookup value is always 5 cells above the location of "some value"
Location of the Table is ; AA1:AB10

I am very excited to receive a reply !


Regards,

 

[mikerickson]

You can pick which of the For loops that you like.

Sub Macro1()
    Dim oneRow as Range
    Dim i As Long
    Dim sameRange As Range
    
  'For Each oneRow in Selection.Rows: Rem alternate 
  For Each oneRow in ActiveSheet.Rows
     With oneRow
        .Cells.HorizontalAlignment = xlGeneral
        Set sameRange = .Cells(1, 1)
        
        For i = 1 To Application.Intersect(.Parent.UsedRange, .Cells).Columns.Count
                If .Cells(1, i).Interior.ColorIndex = sameRange.Cells(1, 1).Interior.ColorIndex Then
                    Set sameRange = Range(sameRange, .Cells(1, i))
                Else
                    If sameRange.Cells(1, 1).Interior.ColorIndex <> xlNone Then
                        sameRange.HorizontalAlignment = xlCenterAcrossSelection
                        sameRange.Cells(1, 1).Value = "some value"
                    End If
                    Set sameRange = .Cells(1, i)
                End If
        Next i
     End With
    
    If sameRange.Cells(1, 1).Interior.ColorIndex <> xlNone Then
        sameRange.HorizontalAlignment = xlCenterAcrossSelection
        sameRange.Cells(1, 1).Value = "some value"
    End If
  Next oneRow
    
End Sub

 

[mikerickson]

That is not a VLOOKUP
I think that what you want might be described as an offset.

I'm not clear about "for example: value returned is from 5 cells above."
What might change it from 5 to 4 cells?
Also, what do you want returned if the cell in question is B2 and there is no "5 cells above"

Perhaps you can adapt this syntax to your needs.

' sameRange.Cells(1, 1).Value = "some value": Rem old line
If 5 < sameRange.Row Then
    sameRange.Cells(1, 1).Value = sameRange.Cells(1, 1).Offset(-5, 0).Value
End If

 

[Slamdunkromeo]

Thank you ! The loop works. For me it's now weekend. I will try to work on the suggested syntax on monday.
I will inform you.

For now, Have a great weekend.

 

[Slamdunkromeo]

Mikerickson,

Thank you for your help ! The suggested syntax is the one i need and was able to adjust. I got it all working now, thanks for your support.

Regards,