Merging Cells

[Ginger-daq]

Hi,

How would I go about merging cells with the same values AUTOMATICALLY?

For instance in cells A1:E1, each cell contains a value of 4 except E1 so I require A1:D1 merged.

Driving me insane!! limited excel and VBA knowledge sorry.


Ginger-daq

 

[ciprianmp]

Btw, is it possible to predefine the range interval inside the routine, for more than one sheet (same reference cells though, maybe using indirect()), without having to be pre-selected by the user?

 

[ciprianmp]

You can call this procedure at the top of the original code (before the For Each loop) to un-merge previously merged cells before re-merging.

It's possible to automate it based on Worksheet_Change() event or something similar.

To explore the feasibility of the additional features you're looking for, I would need a more detailed description of the "main range" and "shadow range" and how they're linked. If you can type up a dummy example showing both, before and after, and including formulas and formats (and how they're linked) that would be most helpful.

For the first part of your explanation, here comes another question:
Can I just include the un-merge loop into the merge one and have a single complete procedure on workbook change?

The project structure looks like this (I'll try to be short though):

3 daily sheets:
Team1DAY1 - the sheet where the user inputs his projected activities, in a specific range only (3 columns/sub teams and 72 rows = 18 hours split on 15' intervals). Rest of the sheet is readonly (except for a comment range - out of the print area - where he can also add some explanations). The cell values are predefined from a list. No specific formats needed in this sheet, just raw data.
User chooses one value (let's say Column1) and copies it (drags it) to fill an entire interval (square) e.g. 3 columns (4*15 minutes per row = 1 hour for that activity). If he doesn't fill a square, a notice or red highlight should tell him he did it wrong (not implemented yet).
Team2DAY1 – idem
Team3DAY1 – idem
DAY1 - this is the main sheet where the values chosen in the input sheet Team1DAY1 will be replicated in a "shadow" (identical cells range) which is hidden, but from where, in the same sheet DAY1, I built the “Main Range”, which is supposed to gather a daily schedule for all 3 teams in 9 columns * 72 rows, so we can see if there is any conflict between the activities (conditional formatting will highlight the activities that are overlapped). This range is also the one that needs to be nicely formatted based on color codes, to be exported/copied into a powerpoint for a slideshow to the CEO board (the formatting layout is already working nice with the conditional formatting, but same text shows identical in adjacent cells, so I wanted to merge those identical cells for display purposes).
All 4 sheets, after everything will work as expected will be replicated/re-copied for a full 7 days cycle (sheet names will be changed accordingly DAY2 - Team1DAY2, DAY3 – Team1DAY3 and so on).
Links between main sheet and input sheets are based on the indirect function, which helps if sheet names are changed or the sheets replaced/imported from a different workbook (not to break the original formulas), which works nice so far.
I had to make this "main/shadow" range approach in a single sheet due to the limitation of conditional formatting, which works only on the current sheet.
The user will only have the input sheets and no access to the main file (so no DAY1-7 in his workbook). Then his sheets are imported into the main file and the DAY1-7 sheets are updated and formatted based on what he planned.
After de-conflicting the 3 teams’ activities, the final sheets DAY1-7 will generate the ppt for projection on the wall.
During the 7 days, activities might change drastically, so I needed this kind of automation. Before, copy&paste was used and that was such a pain. Human errors on deconflicting could also occur very often.

I hope this gives you a broader idea about this project structure.
I know it’s similar to what Microsoft Project could do, but not all the input users have that installed and the layout of the schedules in MP doesn’t meet our requirements for a nice and feasible display approach.

If you come up with some new ideas about an approach to fully automate this project in a better fashion, it would be more than appreciated.
Thank you so much!

 

[ciprianmp]

@iliace Ok, I finally was able to test your codes (macros were disabled before) so this is what I found:
- the mergeSameCells macro only merges cells horizontaly, row-by-row, not on the columns of the same range. So
5 5 5 5 5
5 5 5 5 5
goes like
5
5
- when unmerging the cells, the formulas are copied from the first cell of the range and put identically in every unmerged cell, so the references are not shifted accordingly IOT match the Cell+1 refs (A1->B1 horizontally and A1->A2 vertically). Can this be fixed in the macro code, so when unmerging, the ref letters will increment horizontally and ref numbers will increment vertically by one unit lets say?

Still waiting for your feedback on my previous posts. Did you get to read them?
Thanks!

 

[iliace]

Still waiting for your feedback on my previous posts. Did you get to read them?
Thanks!

It's on my to-do list, but I haven't had time. I need to think about how best to do it, as well as identify anomalies such as jagged (non-rectangular) ranges.

For un-merge, my thinking was that, since you're un-merging previously merged cells and therefore any formulas that were there previously are deleted, you would want the same formula. If you're operating under the assumption that any formulas should be relative to their respective cell, you can use this instead:

Public Sub unmergeSameCell()
  Dim rng As Excel.Range
  Dim rngAll As Excel.Range
  Dim rngMerged As Excel.Range
  
  If VBA.TypeName(Selection) <> "Range" Then Exit Sub
  
  Set rngAll = Application.Selection
  Application.Calculation = Excel.xlCalculationManual
  Application.ScreenUpdating = False


  For Each rng In rngAll.Cells
    If rng.MergeCells Then
      Set rngMerged = rng.MergeArea
      rng.UnMerge
      rngMerged.Range("A1").Copy rngMerged
    End If
  Next rng
  
  Application.Calculation = Excel.xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

 

[iliace]

By the way, in all of these procedures, I'm assuming that your calculations are automatic to begin with, and resetting them back to automatic at the end of execution. So I apologize if that's not the case.

 

[ciprianmp]

By the way, in all of these procedures, I'm assuming that your calculations are automatic to begin with, and resetting them back to automatic at the end of execution. So I apologize if that's not the case.

Yes, it's automatic. Monday I will try that formula correction. To explain a little better, before first merge, there is a formula in each cell, to replicate the corresponding cell value from the shadow range of the same sheet (for conditional formatting to work). All the values and calculations are text only. So after I merge, only the first left-up formula is kept, then on first unmerge (to prepare the next merge after value changes in the editing sheet and the shadow range), the formula needs to propagate incremental in the new split cells, exactly as it was before. This will bring in new content and formats according to the new values in the shadow area. I think your formula will do that. I'll let you know.

 

[iliace]

OK, so I have this code so far, which will do the following:

- Find a consecutive block of cells in a row (even if it's just one)
- Look for any consecutive cells below
- As soon as a different value is encountered, merge

However, here is the issue I'm finding. This is a portion of my test data:

1 2 3 4
1 2 2 2
2 2 2 2
3 2 2 2
4 2 2 2
6 7 8 9

What happens here is B1:B5 become merged (because there are values of 2 below the initial 2). Then, C2:D5 become merged separately (because it encounters C2:D2 and looks for consecutive data below it). I'm not sure whether this is the desired behavior or if you would ever encounter a situation like this.

This is the code, try it out and post back.

Public Sub mergeByBlock()
  Dim rng As Excel.Range, rngPrev As Excel.Range
  Dim rngAll As Excel.Range, rngMerge As Excel.Range
  Dim rngBegin As Excel.Range, rngEnd As Excel.Range
  Dim rngBlock As Excel.Range
  
  Dim iRow As Long
  
  Dim calcs As Excel.XlCalculation
  
  If VBA.TypeName(Selection) <> "Range" Then Exit Sub
  
  Set rngAll = Application.Selection
  calcs = Application.Calculation
  Application.Calculation = Excel.xlCalculationManual
  Application.ScreenUpdating = False
  
  For Each rng In rngAll.Cells
    If rngBegin Is Nothing Then
      Set rngBegin = rng
      Debug.Print "Starting at " & rngBegin.Address
    ElseIf rng.Value <> rngPrev.Value Or rng.Row <> rngPrev.Row Then
      If (VBA.Len(rngPrev.Value) > 0) Then
        Set rngEnd = rngPrev
        Set rngMerge = Range(rngBegin, rngEnd)
        ' look for block
        
        For iRow = 1 To rngAll.Rows.Count
          If rngMerge.Offset(iRow, 0).Range("A1").Value <> rngBegin.Value Then Exit For
          Debug.Print rngMerge.Offset(iRow, 0).Address & " is part of range"
        Next iRow
        
        Set rngMerge = rngMerge.Resize(iRow, rngMerge.Columns.Count)
        
        If rngMerge.Cells.Count > 1 Then
          Application.DisplayAlerts = False
          rngMerge.Merge
          Debug.Print rngMerge.Address; " is merged"
          Application.DisplayAlerts = True
       End If
      End If
      Set rngBegin = rng
    End If
    Set rngPrev = rng
  Next rng
  
  Set rngEnd = rngAll.Cells(rngAll.Cells.Count)
  Set rngMerge = Range(rngBegin, rngEnd)
  
  If rngMerge.Cells.Count > 1 Then
    Application.DisplayAlerts = False
    rngMerge.Merge
    Application.DisplayAlerts = True
  End If
  
  Application.Calculation = calcs
  Application.ScreenUpdating = True
End Sub

 

[ciprianmp]

Both subs worked flawlessly for my purpose! Thank you!

Please be aware of the 0 values vs null ones. I cannot reproduce the behaviour here but I got some strange merging when there where 0 values in the main range.

In the image below, there is something strange with 77s and 55s...

For me, 5s are ok, it is good how it merges - vertically first. But for 77s, I would prefer two separated blocks, if it will ever be the case.

Thank you.

PS: can you show me an example of how to define a certain region (or more) in the macro code you posted already, and not having to select it first? I need it predefined, either by cell addresses or using Names (whichever you think it's more reliable). And if it's possible to apply to the same ranges in the entire workbook or on more than one sheet, it would be great. I have at least 7 sheets (days of week) with identical structure (ranges) but different data.

 

[iliace]

Blanks in this case cannot be treated as merge areas because they don't meet the original requirement of being in rectangular blocks. So, to avoid them, add this little bit of code (replace 4th line inside For Each loop):

    ElseIf rng.Value <> rngPrev.Value Or rng.Row <> rngPrev.Row Or VBA.Len(rng) = 0 Then

To run it on a specified range, for example in the above example A1:C11, you can set up a Const (for easy maintenance):

Const sMergeRange As String = "A1:C11"

Then, replace this line:

  Set rngAll = Application.Selection

With this:

  Set rngAll = Application.ActiveSheet.Range("sMergeRange")

You can then run this code on any sheet, and range A1:C11 will be merged.



Alternately, you can call the macro from an even proc. For example, inside the workbook module, define two ranges:

Const sMergeRange As String = "A1:C11"
Const sShadowRange As String = "M1:O11"

Then use this event code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Not Intersect(Sh.Range(sShadowRange), Target) Is Nothing Then
    Sh.Range(sMergeRange).Select
    Call unmergeSameCell
    Call mergeByBlock
  End If
End Sub

and then each time you change the shadow range, the merge range is un-merged and merged again to account for new values. It's largely up to you how to invoke the functionality.

 

[SIXTYAVE]

Hi iliace,

My issue is very similar to this.

I have a product file with 24 columns. Some products have different sizes and colors. I will like to merge all the rows with same sku number and get the content of size and color cells that are unique to be merged and at the same time making sure there are no duplicate value in ALL cells.

Thanks.