Please assist with concatenate coding.

[Disconnected]

Abstract:
Search entire sheet for all duplicate values in one column, then take all of the matching data in the next column and merge them all into one cell, then remove all of the duplicate rows except for the first one.

Concrete:
Column C contains a unique identifier that may or may not repeat itself.
If the identifier in Column C repeats itself, for the first row in that entire range where the identifier is repeated, I want to set Dx as a set cell.
I then copy cell D for each row that repeats and merge all of that data into the first Dx cell.
The d.exists creates an object where one doesn't exist before. This allows me to skip past a row where only one cell of the data exists.
I set the e.Font.ColorIndex so I could visualize the code "seeing" each subsequent cell in Column C (to help me learn).Problem:
I cannot figure out how to loop this such it will concatenate all the data into one cell.

For example:
A random range (C3:C7 in this case) contains the same value 2438.
I want to merge all data in D3:D7 into D3, then remove the rows 4:7.
First row found in the range will always remain.
All subsequent rows will be deleted.What say you, oh VBA masters? I cannot thank you enough for your help.

Code has been bolded and sized.

Sub MergeSheetsDDMI()

Dim iSheet, iTargetRow As Long, oCell As Object, bRowWasNotBlank As Boolean
Dim iTop, iLeft, iBottom, iRight As Long
Dim appidRange As Range
Dim Cell
Dim d As Object, e, f
Set d = CreateObject("scripting.dictionary")

Sheets(1).Select: Sheets.Add
Sheets(1).Select
Cells.Select
Selection.Clear
bRowWasNotBlank = True
For iSheet = 4 To ThisWorkbook.Sheets.Count: DoEvents
For Each oCell In Sheets(iSheet).Cells(1, 1).CurrentRegion.Cells: DoEvents
If oCell.Column = 1 Then
If bRowWasNotBlank Then iTargetRow = iTargetRow + 1
bRowWasNotBlank = False
End If

If oCell.MergeCells Then
bRowWasNotBlank = True
If oCell.MergeArea.Cells(1).Row = oCell.Row Then
If oCell.MergeArea.Cells(1).Column = oCell.Column Then
Sheets(1).Cells(iTargetRow, oCell.Column) = oCell
iTop = iTargetRow
iLeft = oCell.Column
iBottom = iTop + oCell.MergeArea.Rows.Count - 1
iRight = iLeft + oCell.MergeArea.Columns.Count - 1
Sheets(1).Range(Cells(iTop, iLeft), Cells(iBottom, iRight)).MergeCells = True
End If
End If
End If

If Len(oCell) Then bRowWasNotBlank = True
Sheets(1).Cells(iTargetRow, oCell.Column) = oCell
Next oCell
Next

'Format merged sheet.
Sheets(1).Select
Cells.Select
Cells.EntireColumn.AutoFit
Range("B:B").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.Name = "DDMI Application Data"

'Sets Column E horizontal alignment to Left.
Range("D:D").Select
With Selection
.HorizontalAlignment = xlLeft
End With
Range("A1").Select

'Copies all different application versions to first cell of that AppID, that row, column D.

For Each e In Intersect(Columns(3), ActiveSheet.Range("C2:C7")) 'Change ActiveSheet to ActiveSheet.UsedRange
If e.Value <> vbNullString Then
If Not d.exists(e.Value) Then d(e.Value) = 1 Else _
e.Font.ColorIndex = 32
e.End(xlToLeft).Offset(, 3).Copy

MsgBox "Boo."

End If
Next

'Sheets("Macros").Select
Range("A1").Select

End Sub

[Bob Phillips]

Sub Duplicates()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim cell1 As Range
Dim tmp As String

With ActiveSheet

Set rng = .Range("C3:C7")
.Rows(rng.Row).Insert
Set rng1 = rng.Offset(-1, 0).Resize(rng.Rows.Count + 1)
rng1.Cells(1, 1).Value = "tmp"
rng1.Cells(1, 2).Value = "blanks"
For Each cell In rng

tmp = ""

If Application.CountIf(rng.Cells(1, 1).Resize(cell.Row - 3), cell.Value) = 1 Then

rng1.AutoFilter Field:=1, Criteria1:=cell.Value
For Each cell1 In rng.Offset(0, 1).SpecialCells(xlCellTypeVisible)

tmp = tmp & "," & cell1.Value
Next cell1

cell.Offset(0, 1).Value = Right$(tmp, Len(tmp) - 1)
Else

cell.Offset(0, 1).Value = ""
End If
Next cell

rng1.AutoFilter
rng1.Offset(0, 1).AutoFilter Field:=1, Criteria1:=""
rng1.Offset(0, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub

[snb]

Sub M_snb()
sn = Cells(3, 3).CurrentRegion

For j = 2 To UBound(sn)
y=Application.Match(sn(j, 1), Application.Index(sn, , 1), 0)
If y< j Then
sn(y, 2) = sn(y, 2) & sn(j, 2)
sn(j, 1) = ""
End If
Next

With Cells(3, 3).CurrentRegion
.Value = sn
.Columns(1).SpecialCells(4).EntireRow.Delete
End With
End Sub

[Disconnected]

Gracias. Let me dissect this and see if it works.

If I may:

Can I get an abstract or a concrete explanation of why this works? I'm trying to learn also but I don't demand that you explain - the only stupid question is one not asked, right?

[snb]

Use the 'locals' window in the VBEditor and use the step by step method to see what he code does.

[Disconnected]

xld: Your code works but I have no clue why. LOL.

:)

This presents a new challenge, as the rng is set to a static range. rng will always be dynamic. I attempted to present the initial problem as needing to be solved dynamically.

For example:

Column C, Column D
Header, Header
C2, D2: 2439, 4.05
C3, D3: 2438, 4.05
2438,5
2438,5.0.5
2438,6
2438,6.0.1
5218,1,1
2317,2.1
...
...
2317,6

So while C3:C7 is successfully concatenated that range is arbitrary.

The next range I need this applied to in my sheet is C9:D18 but is again arbitrary.

I really appreciate your assistance and hope I can learn. :o)

[Disconnected]

Use the 'locals' window in the VBEditor and use the step by step method to see what he code does.

Thanks. I will do that right now. :o)

[Disconnected]

Looks like my reply was lost. :(

Unfortunately, while the code works perfectly, I need this for an arbitrary range of equal values within the C column.

That range could be C3:C30 or from C1592:1593 and will never be the same.

Thanks for your help. :o)