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!

 

[rainx]

I tried this:


Sheets("sheet2").Range("a1").Resize(n, 2).Value = b</pre>
But there is an application defined or object defined error...

THanks!

 

[jindon]

try

Sub test()
Dim a, b(), i As Long, n As Long, temp As String, e
With Sheets("YourSheetNameWithDataHere")
    a = .Range("a1" .Range("a" & Rows.Count).End(xlUp)).Resize(,2).Value
    ' where a1 has heading, change to suite
End With
ReDim b(1 To UBound(a,1), 1 To 2)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 2 To UBound(a,1)
        If Not .exists(a(i,2)) Then
            n = n + 1 : b(n,1) = a(i,2) : .add a(i,2), n
        End If
        b(.item(a(i,2)), 2) = b(.item(a(i,2)), 2) & _
                IIf(b(.item(a(i,2)), 2) <> "", ",", "") & a(i,1)
    Next
    .removeall
    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
End With
Sheets("DestinationSheetNameHere").Range("a1").Resize(n,2).Value = b
End Sub

 

[rainx]

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

this come out in red.. dunno why..

thanks!

 

[jindon]

Missed a comma ","

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

 

[rainx]

I change to tis

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

is that right?

Thanks!

 

[rainx]

oh there is a . before Range.. okie I try!

Thanks!

 

[rainx]

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

I still have an error with this line.. application defined or object...

Thanks!

 

[jindon]

If that happens, most probably, setting range of a is not correct.
Can you tell me exact address of your dara range ?

 

[rainx]

er, but when i tried changing to sheet 2 instead of sheet 1 den it works le?
whats the issue with sheet 1 ar?

Thanks!

 

[jindon]

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

I still have an error with this line.. application defined or object...

Thanks!

Well if the error saying "Out of subscript", then your sheet name is incorrect, but object difined error....

No idea...