merging data in one row

[dankar]

ID	Part number	Kind	manf. date	comments
300	100	L	09/05/2001	toyota
300	101	R	06/03/2001	toyota
301	200	L	01/01/2015	Honda
301	201	R	01/01/2015	Honda
302	300	L	01/03/2012	Nissan
302	301	R	01/05/2014	Nissan

<tbody>
</tbody>

After merging:

ID	Part number	Kind	manf.date	comments
300	100	L	09/05/2001	toyota	101	R	06/03/2001	toyota
301	200	L	01/01/2015	Honda	201	R	01/01/2015	Honda
302	300	L	01/03/2012	Nssan	301	R	01/05/2014	Nissan

<tbody>
</tbody>

Hi.

I have 275 row wit duplicated ID numbers that have different results ,I need t merge them in one row (to have the second row at the end of the first row)

is there a way to do this in easy was instead of copy paste each line.

the total rows should be 135 at the end.

Thanks.

 

[Fluff]

How about

Sub ConvertToRows()
   Dim cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each cl In Range("A1", Range("A" & Rows.count).End(xlUp))
         .Item(cl.Value) = .Item(cl.Value) & Join(Application.Index(cl.Offset(, 1).Resize(, 4).Value, 1, 0), "|") & "|"
         Debug.Print .Item(cl.Value)
      Next cl
      Range("H1").Resize(.count).Value = Application.Transpose(.keys)
      Range("I1").Resize(.count).Value = Application.Transpose(.items)
      Range("I1").Resize(.count).TextToColumns Range("I1"), xlDelimited, _
        xlDoubleQuote, False, False, False, False, False, True, "|"
   End With
End Sub

 

[dankar]

Thanks for your help.

wen am applying the code am getting this:
"There's already data here. Do you want to replace it?"

how can I get the result in new sheet? thank you

 

[Fluff]

How about

Sub ConvertToRows()
   Dim cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each cl In Range("A1", Range("A" & Rows.count).End(xlUp))
         .Item(cl.Value) = .Item(cl.Value) & Join(Application.Index(cl.Offset(, 1).Resize(, 4).Value, 1, 0), "|") & "|"
         Debug.Print .Item(cl.Value)
      Next cl
      Sheets.Add
      Range("A1").Resize(.count).Value = Application.Transpose(.keys)
      Range("B1").Resize(.count).Value = Application.Transpose(.items)
      Range("B1").Resize(.count).TextToColumns Range("B1"), xlDelimited, _
        xlDoubleQuote, False, False, False, False, False, True, "|"
   End With
End Sub

 

[dankar]

Sorry..

it worked but I noticed that it gave only the first 5 columns.

I have 14 column (from A to N) and 270 row.

I thought the code will just take the second raw and put it in te end of the last column.

sorry if i was mistaken in explaining ..my example was just to explain the idea..(the example i gave is not he complete table)

 

[Fluff]

In that case make this change

.Item(cl.Value) = .Item(cl.Value) & Join(Application.Index(cl.Offset(, 1).Resize(, [COLOR=#ff0000]13[/COLOR]).Value, 1, 0), "|") & "|"

 

[dankar]

Sorry for bothering you..

i made the change and i got this :

Run-time error '13':
Type mismatch

and a new blank sheet was created

 

[Fluff]

Which line gave that error?

 

[sandy666]

if you are able to use PowerQuery try
- load table to PQ editor
- duplicate table
- filter 1st table by L
- add index
- filter 2nd table by R
- add index
- merge tables by index
- expand column
- remove unnecessary column

 

[dankar]

Thank a lot for your help..problem solved.