VBA Macro to Merge Cells based on Column Values - excel

Question

I'm trying to merge cells in excel using VBA based on the column value. For instance, on row one, wherever the month is the same, merge those cells. I've tried the following code :
Sub Main()
Dim j As Long
For j = 1 To 13
If StrComp(Cells(1, j), Cells(1, j + 1), vbTextCompare) Then
Range(Cells(1, j), Cells(1, j + 1)).Merge
End If
Next j
End Sub
Here, I'm keeping the row fixed as the first row and iterating over the columns and checking if the next cell value is same as the current value. However, in the output it's merging incorrect cells. What am I missing here?

Answer 1

This is easier to understand.
Application.DisplayAlerts = False
With ThisWorkbook.Sheets("Sheet1")
For i = 13 To 2 Step -1 'Loop from the last cell, and stop at the second column
If .Cells(1, i).Value = .Cells(1, i).Offset(, -1).Value Then
.Range(.Cells(1, i), .Cells(1, i).Offset(, -1)).Merge
End If
Next i
End With
Application.DisplayAlerts = True

Answer 2

Should work like this …
Option Explicit
Public Sub MergeSameValuesInRow()
Const iRow As Long = 1 'the row number
Const FirstColumn As Long = 1 'first column with data in iRow
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'define your worksheet
Dim LastColumn As Long 'find last used column in iRow
LastColumn = ws.Cells(iRow, ws.Columns.Count).End(xlToLeft).Column
Dim StartCell As Range 'remember the start cell (first occurence of a new value)
Set StartCell = ws.Cells(iRow, FirstColumn)
Dim iCol As Long
For iCol = FirstColumn + 1 To LastColumn + 1 'loop through columns in iRow
If ws.Cells(iRow, iCol).Value <> StartCell.Value Then 'if value changed …
Application.DisplayAlerts = False 'hide merging messages
ws.Range(StartCell, ws.Cells(iRow, iCol - 1)).Merge 'merge from start cell until one before value change
Application.DisplayAlerts = True
Set StartCell = ws.Cells(iRow, iCol) 'set start cell to the next value
End If
Next iCol
End Sub
It will change this …
into this …