Unique values from rows combined into single row

[kravspelunker]

Hey all, I apologize if this is an easy topic that I've missed elsewhere in the forums but I haven't had much luck in finding anything.

I have a large spreadsheet that has lots of information that repeats various information in different rows. What I would like to do is to collect all of this information from multiple rows in the spreadsheet into a single row whose cells contain all of the information from all other rows but without any of the repeating. I'm having some difficulty even articulating what I need help with so I've put a quick example of what I am trying to accomplish below. I appreciate your help and responses. Please let me know if I have provided sufficient information.
Many thanks!

Current example:

Row1 Row2 Row3 Row4
machineA unique_value1 FacilityA AppA
machineB unique_value2 FacilityB AppB
machineC unique_value3 FacilityC AppA
machineA unique_value1 FacilityC AppB
machineA unique_value1 FacilityC AppC

Desired result:

Row1 Row2 Row3 Row4
machineA unique_value1 FacilityA, FacilityC AppA, AppC, AppB
machineB unique_value2 FacilityB ApplicationB
machineC unique_value3 FacilityC ApplicationA

 

[kravspelunker]

hiker95,
Yes sir, that's exactly what I am looking for. I have found a separate macro that works to eliminate duplicates in each cell by placing the results in a different column and I can replace one column with the next but obviously the desired result would be to get what I need in one operation.
Many thanks!

 

[hiker95]

kravspelunker,


Sample raw data before the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	Machine	IP	Application	Facility
2
3	MachineA	xxx.yyy.100.1	App_A	Facility_1
4	MachineB	xxx.yyy.100.2	App_C	Facility_2
5	MachineC	xxx.yyy.100.3	App_B	Facility_3
6	MachineA	xxx.yyy.100.1	App_B	Facility_2
7	MachineA	xxx.yyy.100.1	App_B	Facility_1
8	MachineD	xxx.yyy.100.4	App_A	Facility_3
9
Sheet3

After the updated macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J
1	Machine	IP	Application	Facility			Machine	IP	Application	Facility
2
3	MachineA	xxx.yyy.100.1	App_A	Facility_1			MachineA	xxx.yyy.100.1	App_A, App_B	Facility_1, Facility_2
4	MachineA	xxx.yyy.100.1	App_B	Facility_1			MachineB	xxx.yyy.100.2	App_C	Facility_2
5	MachineA	xxx.yyy.100.1	App_B	Facility_2			MachineC	xxx.yyy.100.3	App_B	Facility_3
6	MachineB	xxx.yyy.100.2	App_C	Facility_2			MachineD	xxx.yyy.100.4	App_A	Facility_3
7	MachineC	xxx.yyy.100.3	App_B	Facility_3
8	MachineD	xxx.yyy.100.4	App_A	Facility_3
9
Sheet3

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Option Compare Text
Sub ReorgDataV2()
' hiker95, 07/12/2011
' http://www.mrexcel.com/forum/showthread.php?t=563514
Dim LR As Long, a As Long, SR As Long, ER As Long
Dim u
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
With ActiveSheet.Sort
  With .SortFields
    .Clear
    .Add Key:=Range("A3:A" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Add Key:=Range("B3:B" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Add Key:=Range("C3:C" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Add Key:=Range("D3:D" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  End With
  .SetRange Range("A3:D" & LR)
  .Apply
End With
With Range("E3:E" & LR)
  .FormulaR1C1 = "=RC[-4]&RC[-3]"
  .Value = .Value
End With
Columns("A:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("G1"), unique:=True
Range("J1:K1").Value = Range("C1:D1").Value
LR = Cells(Rows.Count, 7).End(xlUp).Row
With Range("I3:I" & LR)
  .FormulaR1C1 = "=RC[-2]&RC[-1]"
  .Value = .Value
End With
For a = 3 To LR Step 1
  SR = Application.Match(Cells(a, 9), Columns(5), 0)
  ER = Application.Match(Cells(a, 9), Columns(5), 1)
  If SR = ER Then
    Range("J" & a).Value = Range("C" & SR).Value
    Range("K" & a).Value = Range("D" & SR).Value
  Else
    u = unique(Range("C" & SR & ":C" & ER))
    Range("J" & a).Value = u
    u = unique(Range("D" & SR & ":D" & ER))
    Range("K" & a).Value = u
  End If
Next a
Columns(5).ClearContents
Columns(9).Delete
Columns("G:J").AutoFit
Application.ScreenUpdating = True
End Sub

Function unique(ByVal rng As Range) As Variant
' hiker95, 07/12/2011
' http://www.mrexcel.com/forum/showthread.php?t=563514
' Original Functions by Weaver, 06/23/2011
' http://www.mrexcel.com/forum/showthread.php?t=559340
Dim d As Object, c
Dim i
Set d = CreateObject("scripting.dictionary")
For Each i In rng
  c = i.Value
  If Not d.exists(c) Then d.Add c, 1
Next i
unique = Join(d.keys, ", ")
End Function

Then run the ReorgDataV2 macro.

 

[kravspelunker]

hiker95,

This gives me exactly the information I was after. I can't thank you enough. Also, as an aside, I think I got more value out of comparing the two scripts that you provided than I'm getting from the benefit of using the script itself.. The second function is almost exactly like the one I'd found and seeing how you integrated its use in the second vba is/was most educational for me. Thankyou, thankyou,thankyou!

 

[hiker95]

kravspelunker,

You are very welcome.

Glad I could help.

Thanks for the feedback.

Come back anytime.