merge duplicate entries in a table with a macro

[trey2008]

I need some help writing a macro that will combine duplicate entries and delete out one of the entries. Please see table below: In below table I would like to combine the two entries for 123 on one row displaying all three reasons. I have a lot of data, so it would need to be a macro. Any help is appreciated

[TABLE="width: 500"]
<tbody>[TR]
[TD]Request
[/TD]
[TD]Reason1
[/TD]
[TD]Reason2
[/TD]
[TD]Reason3
[/TD]
[/TR]
[TR]
[TD]123
[/TD]
[TD]a
[/TD]
[TD]b
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]123
[/TD]
[TD]c
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]564
[/TD]
[TD]a
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]432
[/TD]
[TD]a
[/TD]
[TD]b
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[trey2008]

<code class="vb keyword">I found this but it combines my reasons in the same cell with a space in-between each value. But this code is too advanced for me to pick apart .

Sub</code> <code class="vb plain">CombineRows()</code>
<code class="vb comments">'Update 20131202</code>
<code class="vb keyword">Dim</code> <code class="vb plain">WorkRng </code><code class="vb keyword">As</code> <code class="vb plain">Range</code>
<code class="vb keyword">Dim</code> <code class="vb plain">Dic </code><code class="vb keyword">As</code> <code class="vb keyword">Variant</code>
<code class="vb keyword">Dim</code> <code class="vb plain">arr </code><code class="vb keyword">As</code> <code class="vb keyword">Variant</code>
<code class="vb keyword">On</code> <code class="vb keyword">Error</code> <code class="vb keyword">Resume</code> <code class="vb keyword">Next</code>
<code class="vb plain">xTitleId = </code><code class="vb string">"KutoolsforExcel"</code>
<code class="vb keyword">Set</code> <code class="vb plain">WorkRng = Application.Selection</code>
<code class="vb keyword">Set</code> <code class="vb plain">WorkRng = Application.InputBox(</code><code class="vb string">"Range"</code><code class="vb plain">, xTitleId, WorkRng.Address, Type:=8)</code>
<code class="vb keyword">Set</code> <code class="vb plain">Dic = CreateObject(</code><code class="vb string">"Scripting.Dictionary"</code><code class="vb plain">)</code>
<code class="vb plain">arr = WorkRng.Value</code>
<code class="vb keyword">For</code> <code class="vb plain">i = 1 </code><code class="vb keyword">To</code> <code class="vb plain">UBound(arr, 1)</code>
<code class="vb spaces">    </code><code class="vb plain">xvalue = arr(i, 1)</code>
<code class="vb spaces">    </code><code class="vb keyword">If</code> <code class="vb plain">Dic.Exists(xvalue) </code><code class="vb keyword">Then</code>
<code class="vb spaces">        </code><code class="vb plain">Dic(arr(i, 1)) = Dic(arr(i, 1)) & </code><code class="vb string">" "</code> <code class="vb plain">& arr(i, 2)</code>
<code class="vb spaces">    </code><code class="vb keyword">Else</code>
<code class="vb spaces">        </code><code class="vb plain">Dic(arr(i, 1)) = arr(i, 2)</code>
<code class="vb spaces">    </code><code class="vb keyword">End</code> <code class="vb keyword">If</code>
<code class="vb keyword">Next</code>
<code class="vb plain">Application.ScreenUpdating = </code><code class="vb keyword">False</code>
<code class="vb plain">WorkRng.ClearContents</code>
<code class="vb plain">WorkRng.Range(</code><code class="vb string">"A1"</code><code class="vb plain">).Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)</code>
<code class="vb plain">WorkRng.Range(</code><code class="vb string">"B1"</code><code class="vb plain">).Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)</code>
<code class="vb plain">Application.ScreenUpdating = </code><code class="vb keyword">True</code>
<code class="vb keyword">End</code> <code class="vb keyword">Sub

</code>