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

 

[iliace]

Any adjacent cell that has the same value should be merged? All in one row, or could be multiple rows?

 

[iliace]

Select your region where you want the merge operation to take place, and run this macro:

Public Sub mergeSameCell()
  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
  
  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 rngBegin Is Nothing Then
      Set rngBegin = rng
    ElseIf rng.Value <> rngPrev.Value Or rng.Row <> rngPrev.Row Then
      Set rngEnd = rngPrev
      Set rngMerge = Range(rngBegin, rngEnd)
      If rngMerge.Cells.Count > 1 Then
        Application.DisplayAlerts = False
        rngMerge.Merge
        Application.DisplayAlerts = True
      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 = Excel.xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

 

[Ginger-daq]

Away from my laptop today but certainly will try thanks!!... it is multiple rows however? Will that make a difference?


Ginger-Daq

 

[Ginger-daq]

Sorry let me give you some info to work on... Each cell is formulated with:

=IF(AND($B5<=G$1,$C5>=G$1),(1*$D5),"")... only an example

So do not want cells with values of "" or 0 to be merged...

I am trying to show workload visually for allocators to work from when allocating a large number of staff over a 24 hour period.

So the formulae above will show (visually) the allocation: Start to Finish time and how many staff allocated. The reason I need the cells merged is so that I can show details of the allocation rather than number of staff upon selection.


Hope this gives you a better idea??????


Ginger-Daq

 

[iliace]

Then you need an additional condition, next to the one checking for the first cell, like this:

  For Each Rng In rngAll.Cells
    If rngBegin Is Nothing [COLOR=red][B]Or CInt(Rng.Value) = 0[/B][/COLOR] Then
      Set rngBegin = Rng
    ElseIf Rng.Value <> rngPrev.Value Or Rng.Row <> rngPrev.Row Then
      Set rngEnd = rngPrev
      Set rngMerge = Range(rngBegin, rngEnd)
      If rngMerge.Cells.Count > 1 Then
        Application.DisplayAlerts = False
        rngMerge.Merge
        Application.DisplayAlerts = True
      End If
      Set rngBegin = Rng
    End If
    Set rngPrev = Rng
  Next Rng

 

[Ginger-daq]

nothing happened yet?... The range I require is K5:IP217

will this effect the code?

 

[iliace]

Select that range and run the code.

 

[Ginger-daq]

Legend!!

Ah I see!... OK tried that but it wouldn't accept the amended (red) bit?

Run Time Error 13... so as guessed using your first post the zeros get merged still?

Any idea's?

 

[iliace]

Do you have non-numeric text in some of the cells?