Matrix to Table

Hi All,

I'm looking for a script to create a datalist based upon the tab "Requirement" combined with the Bill Of Material of the tab BoM.

Example is in the Total tab

Try the attached.

Sub test()
    Dim a, b, i As Long, ii As Long, iii As Long, n As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    a = Sheets("bom").Cells(1).CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dic.exists(a(i, 1)) Then
            Set dic(a(i, 1)) = CreateObject("System.Collections.ArrayList")
        End If
        dic(a(i, 1)).Add Array(a(i, 2), a(i, 3))
    Next
    a = Sheets("requirement").Cells(1).CurrentRegion.Value
    ReDim b(1 To 100000, 1 To 5): n = 1
    For i = 2 To UBound(a, 1)
        For ii = 2 To UBound(a, 2)
            If a(i, ii) <> "" Then
                For iii = 0 To dic(a(1, ii)).Count - 1
                    n = n + 1: b(n, 1) = a(i, 1): b(n, 2) = a(i, ii): b(n, 3) = a(1, ii)
                    b(n, 4) = dic(a(1, ii))(iii)(0): b(n, 5) = dic(a(1, ii))(iii)(1)
                Next
            End If
    Next ii, i
    With Sheets("total").Cells(1).Resize(n, 5)
        .CurrentRegion.ClearContents
        .Value = b
        .Rows(1).Value = Array("Customer", "Ordered", "Product", "Itemnr", "Quantity")
    End With
End Sub

Works super Jindon!

sir jindon what the mean this code

b(n, 4) = dic(a(1, ii))(iii)(0): b(n, 5) = dic(a(1, ii))(iii)(1)

Not interested in replying to a question from someone who ignores/makes no response.

http://www.excelforum.com/excel-prog...ncatenate.html

That line is to output the corresponding data stored in Dictionary

        dic(a(i, 1)).Add Array(a(i, 2), a(i, 3))

to output array "b".

Sir jindon i has use for loop without array
Data in col a:d
I want unique in col a dan sub unique in col b:d
But still error sorri not in mark #
Sub tes ()
Dim d as object : set d = createobject("scripting.dictionary")
For each r in columns(1).specialcells(2)
If not d. Exists(r.value) then
d.add r. Value, array(r.offset(,1),r. Offset(,2),r. Offset(,3))
Else
d.item(r.value) = d.item(r.value), array(r.offset(,1),r. Offset(,2),r. Offset(,3)).value
End if
Next
For each v in d. Keys
n=1:n=n+1
range("a" & n) = v
Range("b" & n) = d(v)
Next
End sub

But i has not sukses











Next

Thankyou for attention mr. Jindon the problem solve..i hope your point will be up thank from triak..and bembeng