VBA code to merge cells with consecutive duplicate entries in Excel

Tonight, I successfully tested VBA code posted here by Extend Office, and also copied below, which you can use to merge consecutive cells with duplicate entries in a column in Excel. So, if you have multiple entries of X in consecutive cells in a column, the macro will merge those cells together but it will not merge the first range of X with a subsequent range later on in the column.

In this example, we first merge the cells in column A with the same entry. After putting the code in new module, select the range, and then go to View . . . Module and run 'MergeSameCell'.

Consecutive duplicate entries are merged in column A, but in column B where the entries of 'New York' are not consecutive they are not merged.

In order for the macro to work correctly you need to select a limited range in a column. You can't select a whole column or $A:$A.

Sub MergeSameCell()

'Updateby20131127

Dim Rng As Range, xCell As Range

Dim xRows As Integer

xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xRows = WorkRng.Rows.Count

For Each Rng In WorkRng.Columns

For i = 1 To xRows - 1

For j = i + 1 To xRows

If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then

Exit For

End If

Next

WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge

i = j - 1

Next

Next

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub