help needed -- link data in 1 cell

[rainx]

Sample data:
<table x:str="" style="border-collapse: collapse; width: 189pt;" width="252" border="0" cellpadding="0" cellspacing="0"><col style="width: 90pt;" width="120"> <col style="width: 99pt;" width="132"> <tbody><tr style="height: 15pt;" height="20"> <td class="xl62" style="height: 15pt; width: 90pt;" width="120" height="20">Machine</td> <td class="xl63" style="width: 99pt;" width="132">Part Number</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl64" style="height: 14.25pt; width: 90pt;" width="120" height="19">machine 1</td> <td class="xl65" style="width: 99pt;" x:num="" width="132" align="right">123</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl64" style="height: 14.25pt; width: 90pt;" width="120" height="19">machine 2</td> <td class="xl65" style="width: 99pt;" x:num="" width="132" align="right">123</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl64" style="height: 14.25pt; width: 90pt;" width="120" height="19">machine 3</td> <td class="xl65" style="width: 99pt;" x:num="" width="132" align="right">123</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl64" style="height: 14.25pt; width: 90pt;" width="120" height="19">machine 1</td> <td class="xl65" style="width: 99pt;" x:num="" width="132" align="right">123</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl64" style="height: 14.25pt; width: 90pt;" width="120" height="19">machine 2</td> <td class="xl65" style="width: 99pt;" x:num="" width="132" align="right">456</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl64" style="height: 14.25pt; width: 90pt;" width="120" height="19">machine 1</td> <td class="xl65" style="width: 99pt;" x:num="" width="132" align="right">456</td> </tr> <tr style="height: 14.25pt;" height="19"> <td class="xl64" style="height: 14.25pt; width: 90pt;" width="120" height="19">machine 3</td> <td class="xl65" style="width: 99pt;" x:num="" width="132" align="right">456</td> </tr> </tbody></table>
Hi everyone, I have this problem here, that i need to based on tis sample data come out with sth like tt:

<table x:str="" style="border-collapse: collapse; width: 326pt;" width="434" border="0" cellpadding="0" cellspacing="0"><col style="width: 90pt;" width="120"> <col style="width: 236pt;" width="314"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl62" style="height: 12.75pt; width: 90pt;" width="120" height="17">
</td> <td class="xl62" style="width: 236pt;" width="314">Used In:</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl62" style="height: 12.75pt;" x:num="" height="17">123</td> <td class="xl62">Machine 1, Machine 2, Machine 3</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl62" style="height: 12.75pt;" x:num="" height="17">456</td> <td class="xl62">Machine 2, Machine 1, Machine 3</td> </tr> </tbody></table>

I need to group those machines under 1 part number. For instance, part 123 is used in which machines, I need to state them in a way like above. But repeated should not be stated again.

Hope someone is able to help.

Thanks alot in advance!

 

[jindon]

Rainx, I will let Jindon resolve this, I won't pretend to understand it ray:

lasw10,

Like cornflakegirl stated, there would be variety of ways to solve the problem and if OP gets few of them working then OP can choose the code best fits his understanding/application and it will be the benefit for the readers as well.

 

[rainx]

Try

Option Explicit
Sub tst()
Dim aCol As New Collection, b(), c() As String, i As Integer, x As Integer
Dim a
With Application
a = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row)
ReDim b(1 To UBound(a, 1))
For i = 1 To UBound(a, 1)
On Error Resume Next: aCol.Add Item:=a(i, 2), Key:=CStr(a(i, 2)): b(i) = a(i, 2)
Next
On Error GoTo 0: ReDim c(1 To aCol.Count, 1 To 2)

For i = 1 To aCol.Count
c(i, 1) = aCol.Item(i)
Do Until IsError(.Match(aCol.Item(i), b, 0))
x = .Match(aCol.Item(i), b, 0)
c(i, 2) = IIf(c(i, 2) = "", a(x, 1), c(i, 2) & "," & a(x, 1)): b(x) = Empty
Loop
Next
Range("D2").Resize(UBound(c, 1), 2).Value = c
End With
End Sub

It works but when data in row 1 den it exclude the result from row 1, and izzit possible to remove duplicate machine in the end result?

Thanks alot!

 

[rainx]

Try this.

Option Explicit
Sub GetMachines()
Dim wsData As Worksheet
Dim wsUnique As Worksheet
Dim LastRow As Long
Dim rng As Range
Dim arrVals As Variant
Dim F As Long
Dim S As Long
Dim I As Long
    Set wsData = Worksheets("Data")
    Set wsUnique = Worksheets.Add
    
    LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
    
    wsData.Range("A1:B" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsUnique.Range("A1:B1"), Unique:=True
    
    Set rng = wsUnique.Range("B2")
    
    S = 2
    
    While rng.Value <> ""
    
        If rng.Value <> rng.Offset(1) Then
        
            I = I + 1
            
            F = rng.Row - 1
            
           arrVals = wsUnique.Range("B" & S).Resize(F - S + 2).Offset(, -1)
           
           arrVals = Application.Transpose(arrVals)
            
           wsData.Range("E" & I) = rng.Value
           
            wsData.Range("F" & I) = Join(arrVals, ",")
            
            S = S + F
            
        End If
        
        Set rng = rng.Offset(1)
        
    Wend
    
    Application.DisplayAlerts = False
    wsUnique.Delete
    Application.DisplayAlerts = True
End Sub

Hi, mus the data start from row 2 for it to work? cos nth happen if i try put my data from row 4 onwards...

Thanks alot for ya help!

 

[jindon]

1) change

            n = n + 1: b(i, 1) = a(i, 2): .Add a(i, 2), n

to

            n = n + 1: b(n, 1) = a(i, 2): .Add a(i, 2), n

2)
change

 For i = 1 To n
For Each e In Split(b(i,2),",")
    If Not .exists(e) Then
    temp = temp & "," & e
    .add e, Nothing
    End If
    b(i,2) = Mid$(temp,2)
   temp = "" : .removeall
Next
Next

to

    For i = 1 To n
        For Each e In Split(b(i,2),",")
            If Not .exists(e) Then
                temp = temp & "," & e
                .add e, Nothing
            End If
        Next
        b(i,2) = Mid$(temp,2)
        temp = "" : .removeall
    Next

 

[rainx]

Hi

It is working now, but then it will only return one type of machine for each part number. The other machines that use that part too is not reflected.

Thanks alot!

 

[jindon]

I had edited the post, so try again.

 

[rainx]

Can alr! thanks! will the results always appear at Column C? Can i change it to some other place where i wan the results to appear?

Thanks alot!

 

[jindon]

Can alr! thanks! will the results always appear at Column C? Can i change it to some other place where i wan the results to appear?

Thanks alot!

It should now display Col.D & F, not C at the moment.

Change

Range("d1").Resize(n, 2).Value = b

to
wherever you want, e.g

Sheets("sheet2").Range("a1").Resize(n, 2).Value = b

 

[rainx]

If my data doesnt start from Row 1, can I change it too?

Thanks!

 

[jindon]

change

a = Range("a1").CurrentRegion.Resize(,2).Value

to

a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(,2).Value

where "a1" should be the heading.
If your heading is on 6th row then it should be "a6". etc