Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Excel dup names not listed merge cells
I have a spreadsheet example below:
Device Name App Owner King 123 Brown Queen 567 Orange Bishop 789 Black Knight 765 Red King 321 Purple King 987 Brown Knight 456 Red Total 7 Device Name only should be listed once, and the multiple App & Mgr fileds need to be merged into one cell. Need it to look like this: Device Name App Owner King 123, 321,987 Brown, Purple Queen 567 Orange Bishop 789 Black Knight 765, 456 Red Total 4 Thanks in advance!!!! |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Excel dup names not listed merge cells
On Wed, 13 Feb 2013 03:22:30 +0000, KA0812 wrote:
I have a spreadsheet example below: Device Name App Owner King 123 Brown Queen 567 Orange Bishop 789 Black Knight 765 Red King 321 Purple King 987 Brown Knight 456 Red Total 7 Device Name only should be listed once, and the multiple App & Mgr fileds need to be merged into one cell. Need it to look like this: Device Name App Owner King 123, 321,987 Brown, Purple Queen 567 Orange Bishop 789 Black Knight 765, 456 Red Total 4 Thanks in advance!!!! It looks like the Owners should only be listed once, and I will assume that the App should only be listed once also. You can do this with a VBA macro. See the macro comments for some assumptions. As written, the macro will run on the Active Sheeet (usually the one showing) and assumes the data is in A1:Cnn where nn is the number of rows. To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor. Ensure your project is highlighted in the Project Explorer window. Then, from the top menu, select Insert/Module and paste the code below into the window that opens. To use this Macro (Sub), <alt-F8 opens the macro dialog box. Select the macro by name, and <RUN. ========================================= Option Explicit Sub UniqueDevices() Dim vSrc As Variant, vRes() As String Dim rDest As Range Dim collDN As Collection, collAP As Collection, collOW As Collection Dim vUniques() Dim i As Long, j As Long 'Results destination (could be anywhere) Set rDest = Range("E1") 'Assume Source table is in A1:Cn vSrc = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=3) 'Generate list of unique device names Set collDN = New Collection On Error Resume Next For i = 1 To UBound(vSrc, 1) collDN.Add Item:=CStr(vSrc(i, 1)), Key:=CStr(vSrc(i, 1)) Next i On Error GoTo 0 'Dimension Results Array ReDim vRes(1 To collDN.Count, 1 To 3) 'Populate first column For i = 1 To collDN.Count vRes(i, 1) = collDN(i) Next i 'For each DN, get the unique list of Apps and Owners For i = 1 To UBound(vRes, 1) Set collAP = New Collection Set collOW = New Collection For j = 1 To UBound(vSrc, 1) If vRes(i, 1) = vSrc(j, 1) Then On Error Resume Next collAP.Add Item:=CStr(vSrc(j, 2)), Key:=CStr(vSrc(j, 2)) collOW.Add Item:=CStr(vSrc(j, 3)), Key:=CStr(vSrc(j, 3)) On Error GoTo 0 End If Next j 'Add Apps to results array ReDim vUniques(1 To collAP.Count) For j = 1 To collAP.Count vUniques(j) = collAP(j) Next j vRes(i, 2) = Join(vUniques, ", ") 'add owners to results array ReDim vUniques(1 To collOW.Count) For j = 1 To collOW.Count vUniques(j) = collOW(j) Next j vRes(i, 3) = Join(vUniques, ", ") Next i 'Size destination Application.ScreenUpdating = False Set rDest = rDest.Resize(rowsize:=UBound(vRes, 1), columnsize:=UBound(vRes, 2)) rDest.EntireColumn.Clear rDest = vRes rDest.EntireColumn.AutoFit Application.ScreenUpdating = True End Sub ============================ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Match file names listed in column with file names in folder | Excel Programming | |||
Trying to merge from excel to word. New names won't merge | Excel Worksheet Functions | |||
merge a wordfile of names & addresses to an excel separate cells | Excel Worksheet Functions | |||
need formula for # names listed * $5 | Excel Worksheet Functions | |||
Need to randomly populate a 10x10 array of cells with 100 names - 5 people listed 20 times each... | Excel Programming |