Procedure for merging common values in same column

[cwb1021]

Hello Experts,

Im attempting to write a procedure that will merge the common values in a column to a single cell. In the picture here I have shown the data set in column A and the desired results in column B.


18674


Below is where I've started. I'm not sure if im going about this the right way and my syntax is off. I've also attached the worksheet.

Sub MarkerMerge()
Dim MarkerRange As Range, cell As Range
Dim wsS1 As Worksheet

Sect wsS1 = Worksheets("Sheet1")
Set MarkerRange = Intersect(wsS.Columns(1), wsS.UsedRange)

For Each cell In MarkerRange
If cell.Value = cell.Offset(-1, 0) Then
ActiveCell.Select
ActiveCell.Offset(-1, 0).Select
Range(ActiveCell.Address, ActiveCell.End(xlUp)).Select

With Selection
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
Next cell
End Sub

Alternatively, I could use a worksheet function to populate column B with arguments from column A.

Any help is greatly appreciated!

Thanks,

Chris

[rlv]

I was not able to open your workbook. Excel reported some sort of format error. To continue with your basic approach (which assumes the data in the "Marker" Column is already sorted), here's one way:


Sub MarkerMerge()
Dim MarkerRange As Range, MarkerCell As Range, MergeRange As Range
Dim wsS1 As Worksheet
Dim i As Long, j As Long

Set wsS1 = Worksheets("Sheet1")
Set MarkerRange = Application.Intersect(wsS1.Columns(1), wsS1.UsedRange).Offset(1, 0)
MarkerRange.Copy MarkerRange.Offset(0, 1)
wsS1.UsedRange.MergeCells = False 'clear any preexisting merged cells

i = 0
j = 1
For Each MarkerCell In MarkerRange
i = i + 1
If MarkerCell.Value = MarkerCell.Offset(-1, 0).Value Then
j = j + 1
Else
If j > 1 Then
Set MergeRange = MarkerRange.Offset(i - j - 1, 1).Resize(j, 1)
With MergeRange
.Range("A1").Value = .Range("A1").Offset(0, -1).Value
Application.DisplayAlerts = False
.MergeCells = True
Application.DisplayAlerts = True
End With
End If
j = 1
End If
Next MarkerCell

With MarkerRange.Offset(0, 1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End Sub

[cwb1021]

rlv,

Sorry for not stating so, but yes, the data in column A was sorted already. This worked perfectly. Thanks so much for your help!

-Chris