I have changed Selection to ActiveSheet.Used Range.....OR change it to a
definite range to suit your requirement.


Sub MergebyColorIndex()

Dim arrRange() As Range, arrIndex() As Variant
Dim cell As Range, blnFound As Boolean, intTemp As Integer

ReDim arrRange(0): ReDim arrIndex(0)

For Each cell In ActiveSheet.UsedRange
If cell.Interior.ColorIndex < xlColorIndexNone Then
blnFound = False

For intTemp = 1 To UBound(arrIndex)
If arrIndex(intTemp) = cell.Interior.ColorIndex Then
Set arrRange(intTemp) = Union(arrRange(intTemp), cell)
blnFound = True: Exit For
End If
Next

If blnFound = False Then
ReDim Preserve arrRange(intTemp)
ReDim Preserve arrIndex(intTemp)
arrIndex(intTemp) = cell.Interior.ColorIndex
Set arrRange(intTemp) = cell
End If

End If
Next

For intTemp = 1 To UBound(arrRange)
arrRange(intTemp).Merge
Next

End Sub

--
Jacob (MVP - Excel)


"Gary Capindale" wrote:

Hi guys,

I am hoping that some one here can help me,

First off i have a very, very basic knowledge of excel and vba so please
bear with me and i will try to describe what it is i am trying to do as best
as possible.

I have a worksheet that has a list of equipment down the left hand side and
week numbers going across the top 1 to 52. The spreadsheet is essentially a
plan of what equipment is being used by certain processes, represented by
coloured or patterned formatted cells in the weeks they will be in use. Kind
of like a gantt chart. Currently i have a spreadsheet were i copy the current
plans colours across to a template spreadsheet to tidy it up. I need to merge
and centre justify the cells in order to give each block a process name.

I am trying to go from left to right from weeks 1 to 52 and merge any cell
of the same colour or pattern if they are situated in direct proximity to one
another. I would also like to merge top to bottom as well as some processes
use multiple sets of equipment so would require to be merged across rows as
well.

I have tried to figure this out by recording macros, but they are massive
and don't work quite right. Obviously some kind of loops would be more
efficient. But i have no knowledge of how these things work really.

Thanks.

Gary.

Wow, thanks for the swift reply. It has really helped me. It works perfectly
as a solve. As it is only a small spreadsheet i think.

How would i go about setting up a finite range as the cells go from E5 to
BD38 and will always remain this way, i would also like the merge cells to be
automatically set up with centred text.

Thanks Jacob your a regular excel guru and a life saver.

"Jacob Skaria" wrote:

I have changed Selection to ActiveSheet.Used Range.....OR change it to a
definite range to suit your requirement.


Sub MergebyColorIndex()

Dim arrRange() As Range, arrIndex() As Variant
Dim cell As Range, blnFound As Boolean, intTemp As Integer

ReDim arrRange(0): ReDim arrIndex(0)

For Each cell In ActiveSheet.UsedRange
If cell.Interior.ColorIndex < xlColorIndexNone Then
blnFound = False

For intTemp = 1 To UBound(arrIndex)
If arrIndex(intTemp) = cell.Interior.ColorIndex Then
Set arrRange(intTemp) = Union(arrRange(intTemp), cell)
blnFound = True: Exit For
End If
Next

If blnFound = False Then
ReDim Preserve arrRange(intTemp)
ReDim Preserve arrIndex(intTemp)
arrIndex(intTemp) = cell.Interior.ColorIndex
Set arrRange(intTemp) = cell
End If

End If
Next

For intTemp = 1 To UBound(arrRange)
arrRange(intTemp).Merge
Next

End Sub

--
Jacob (MVP - Excel)


"Gary Capindale" wrote:

Hi guys,

I am hoping that some one here can help me,

First off i have a very, very basic knowledge of excel and vba so please
bear with me and i will try to describe what it is i am trying to do as best
as possible.

I have a worksheet that has a list of equipment down the left hand side and
week numbers going across the top 1 to 52. The spreadsheet is essentially a
plan of what equipment is being used by certain processes, represented by
coloured or patterned formatted cells in the weeks they will be in use. Kind
of like a gantt chart. Currently i have a spreadsheet were i copy the current
plans colours across to a template spreadsheet to tidy it up. I need to merge
and centre justify the cells in order to give each block a process name.

I am trying to go from left to right from weeks 1 to 52 and merge any cell
of the same colour or pattern if they are situated in direct proximity to one
another. I would also like to merge top to bottom as well as some processes
use multiple sets of equipment so would require to be merged across rows as
well.

I have tried to figure this out by recording macros, but they are massive
and don't work quite right. Obviously some kind of loops would be more
efficient. But i have no knowledge of how these things work really.

Thanks.

Gary.