Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to merge cells of the same colour/pattern index
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. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to merge cells of the same colour/pattern index
Thanks for the feedback. Modified to suit your req..
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 Range("E5:BD38") 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) With arrRange(intTemp) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .ShrinkToFit = False .MergeCells = False End With arrRange(intTemp).Merge Next End Sub -- Jacob (MVP - Excel) "Gary Capindale" wrote: 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. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro to merge cells of the same colour/pattern index | Excel Programming | |||
Macro to merge cells of the same colour/pattern index | Excel Programming | |||
colour pattern | Excel Discussion (Misc queries) | |||
Colour and Pattern Formatting Cells | Excel Programming | |||
How can I count cells of a specific colour (pattern)? | Excel Worksheet Functions |