create unique row in excel

[G2K]

hi all,

i have data in worksheet in tabular format like

<TABLE dir=ltr borderColor=#05ad00 cellSpacing=1 cellPadding=2 width=269 border=1><TBODY><TR><TD width="25%" height=16>

JobName​

​

​

​

​

</TD><TD width="25%" height=16>

JobType​

​

​

​

​

</TD><TD width="25%" height=16>

Machine​

​

​

​

​

</TD><TD width="25%" height=16>

Worker​

​

​

​

​

</TD></TR><TR><TD width="25%" height=16>

A​

​

​

​

​

</TD><TD width="25%" height=16>

J1​

​

​

​

​

</TD><TD width="25%" height=16>

M1​

​

​

​

​

</TD><TD width="25%" height=16>

xyz​

​

​

​

​

</TD></TR><TR><TD width="25%" height=16>

A​

​

​

​

​

</TD><TD width="25%" height=16>

J1​

​

​

​

​

</TD><TD width="25%" height=16>

M1​

​

​

​

​

</TD><TD width="25%" height=16>

wxy​

​

​

​

​

</TD></TR><TR><TD width="25%" height=16>

A​

​

​

​

​

</TD><TD width="25%" height=16>

J1​

​

​

​

​

</TD><TD width="25%" height=16>

M1​

​

​

​

​

</TD><TD width="25%" height=16>

pqr​

​

​

​

​

</TD></TR></TBODY></TABLE>

i want to keep all workers name in one cell seperated by comma and remove remaining two rows. the output data should look like -

<TABLE dir=ltr borderColor=#02ad00 cellSpacing=1 cellPadding=2 width=283 border=1><TBODY><TR><TD width="24%" height=16>

JobName​

​

​

​

​

</TD><TD width="24%" height=16>

JobType​

​

​

​

​

</TD><TD width="24%" height=16>

Machine​

​

​

​

​

</TD><TD width="29%" height=16>

Worker​

​

​

​

​

</TD></TR><TR><TD width="24%" height=16>

A​

​

​

​

​

</TD><TD width="24%" height=16>

J1​

​

​

​

​

</TD><TD width="24%" height=16>

M1​

​

​

​

​

</TD><TD width="29%" height=16>

xyz,wxy,pqr​

​

​

​

​

</TD></TR></TBODY></TABLE>

thanks in advance

 

[jbeaucaire]

Is your data properly sorted like shown above, so like JobName/JobType/Machine are listed in the data together? If so, this simple consolidation routine will do what you want:

Option Explicit
Sub Consolidate()
'JBeaucaire (7/2/2009)
'Merge multi data matching column A & B & C into single row, column D concatenated
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

    For i = LR To 2 Step -1
        If Cells(i, "A").Value = Cells(i - 1, "A").Value And _
          Cells(i, "B").Value = Cells(i - 1, "B").Value And _
            Cells(i, "C").Value = Cells(i - 1, "C").Value Then
                Cells(i - 1, "D") = Cells(i - 1, "D") & "," & Cells(i, "D")
                Rows(i).Delete
        End If
    Next i

Application.ScreenUpdating = True
End Sub

Excel Workbook
	A	B	C	D
1	JobName	JobType	Machine	Worker
2	A	J1	M1	xyz
3	A	J1	M1	wxy
4	A	J1	M1	pqr
5	B	J2	M2	ddd
6	B	J2	M2	aaa
7	C	J1	M1	123
8	D	J2	M2	xyz
9	D	J2	M2	wxy
10	D	J3	M2	ddd
11	D	J3	M2	aaa
BEFORE

Excel Workbook
	A	B	C	D
1	JobName	JobType	Machine	Worker
2	A	J1	M1	xyz,wxy,pqr
3	B	J2	M2	ddd,aaa
4	C	J1	M1	123
5	D	J2	M2	xyz,wxy
6	D	J3	M2	ddd,aaa
AFTER

 

[MickG]

Hi, Your data columns "A to D" , Results start Column "F"

[COLOR="Navy"]Sub[/COLOR] MG02Jul41
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Q, v, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Dn.Next, Dn.Next.Next, Dn.Next.Next.Next)
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
        Q(2) = Q(2) & ", " & Dn.Offset(, 3)
        .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] v [COLOR="Navy"]In[/COLOR] .keys
        c = c + 1
        Cells(c, "F").Value = v
            Cells(c, "G").Value = .Item(v)(0)
                Cells(c, "H").Value = .Item(v)(1)
                    Cells(c, "I").Value = .Item(v)(2)
    [COLOR="Navy"]Next[/COLOR] v
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick