VBA Merge cells in range

[Kra]

Hi all,

I am trying to merge cells using macro, but it works quite oddly and I cannot pick the mistake in code.


Code:

Sub testee()

    Application.DisplayAlerts = False

    Dim rng As Range

MergeCells:

    For Each rng In Selection
        
        If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then
            Range(rng, rng.Offset(1, 0)).Merge
            Range(rng, rng.Offset(1, 0)).HorizontalAlignment = xlCenter
            Range(rng, rng.Offset(1, 0)).VerticalAlignment = xlCenter
            
            Range(rng.Offset(0, 1), rng.Offset(1, 1)).Merge
            Range(rng.Offset(0, 1), rng.Offset(1, 1)).HorizontalAlignment = xlCenter
            Range(rng.Offset(0, 1), rng.Offset(1, 1)).VerticalAlignment = xlCenter
            GoTo MergeCells
        End If
Next



End Sub

Sheet (Data in column A and B, result of macro in column E and F)

BarF.xlsx
	A	B	C	D	E	F
1	A	10			A	10
2	A	10
3	A	10
4	A	10
5	B	10			B
6	B	10
7	B	10
8	B	10
9	B	10
10	B	10
11	C	15			C
12	C	15
13	D	5			D
Sheet4

I want it to merge cells in column A and B based on value in column A only. So if it merges two cells in column A, then it merges 2 cells in column B as well, but now it merges all cells in column B. I am selecting only data in column A before I run macro.

 

[Legacy 143009]

I think I know the problem. Once you merge column A, it takes the new reference as merged cell. What I mean is, once A1 and A2 are merged, the new rng reference becomes A2. So the rng.Offset(1,1) reference becomes B3. If I were you, I would use Cells(R1,C1) reference style to be more precise and in control:

Sub testee()
  Application.DisplayAlerts = False
  Dim rng As Range
MergeCells:

    For Each rng In Selection
      If rng.Value = rng.Offset(1, 0).Value And rng.Value <> "" Then
        Range(Cells(rng.Row, 1), Cells(rng.Offset(1, 0).Row, 1)).Merge
        Range(Cells(rng.Row, 2), Cells(rng.Offset(1, 0).Row - 1, 2)).Merge
        Range(rng, rng.Offset(1, 1)).HorizontalAlignment = xlCenter
        Range(rng, rng.Offset(1, 1)).VerticalAlignment = xlCenter
            
      GoTo MergeCells
    End If
  Next
  
  Application.DisplayAlerts = True
End Sub

 

[HaHoBe]

Hi kra,

you will find problems being raised through MergedCells.

Sub MrE_1226096_1700510()
' https://www.mrexcel.com/board/threads/vba-merge-cells-in-range.1226096/

Dim rng As Range
Dim lngStart As Long

Application.DisplayAlerts = False
lngStart = 1

For Each rng In Selection
  If rng.Value <> rng.Offset(1, 0).Value And rng.Value <> "" Then
    With Range(Cells(lngStart, "A"), Cells(rng.Row, "A"))
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
    End With
    With Range(Cells(lngStart, "B"), Cells(rng.Row, "B"))
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
    End With
    lngStart = rng.Row + 1
  End If
Next rng

Application.DisplayAlerts = True

End Sub

Ciao,
Holger

 

[Kra]

Hi kra,

you will find problems being raised through MergedCells.

Sub MrE_1226096_1700510()
' https://www.mrexcel.com/board/threads/vba-merge-cells-in-range.1226096/

Dim rng As Range
Dim lngStart As Long

Application.DisplayAlerts = False
lngStart = 1

For Each rng In Selection
  If rng.Value <> rng.Offset(1, 0).Value And rng.Value <> "" Then
    With Range(Cells(lngStart, "A"), Cells(rng.Row, "A"))
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
    End With
    With Range(Cells(lngStart, "B"), Cells(rng.Row, "B"))
      .Merge
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
    End With
    lngStart = rng.Row + 1
  End If
Next rng

Application.DisplayAlerts = True

End Sub

Ciao,
Holger

Thank you Holger, works like a charm!