Moving rows to ome row string

[2avrham]

Hi,

There is an option to covert below table layout to one row layout?

Vpo number <tbody> </tbody><colgroup><col></colgroup>	WW	Task	status	OC	QUDF	Comment	Type	TP	Eng_id
Y6192730RS <tbody> </tbody><colgroup><col></colgroup>	19	hot	wip	6681			sample	VNADNAJDNA11	A1
Y6192730RS <tbody> </tbody><colgroup><col></colgroup>	19	cold	done	6682			sample	ASDKAKSFH224	CX
Y6192730RS <tbody> </tbody><colgroup><col></colgroup>	19	edis	done	7738			sample
Y6192730RS <tbody> </tbody><colgroup><col></colgroup>	19	ppv	done	7739			sample

<tbody>
</tbody>

After the change it should look like this and be execute according to "Vpo_number", I have table with many lots numbers and I want that each lot data will be converted to one row only:

Y6192730RS <tbody> </tbody><colgroup><col></colgroup> 19 hot wip 6681 sample VNADNAJDNA11 A1 <tbody> </tbody>	cold done 6682 sample ASDKAKSFH224 CX <tbody> </tbody>	edis done 7738 sample <tbody> </tbody>	ppv done 7739 sample <tbody> </tbody>

<tbody>
</tbody>

As you can see "Vpo number" & "WW" are the same for all rows therefore I need them only once.

Thanks!!!!

 

[Osvaldo Palmeiro]

Hi.
I assumed your headers starting on 'A1'. The output will start on 'M1'

Sub ReplicateRowsToOneRow()
 Dim LR As Long, k As Long, x As Long, m As Long, t As Long, v As Long
  LR = Cells(Rows.Count, 1).End(3).Row
   For k = 2 To LR
    x = Application.CountIfs(Range(Cells(k, 1), Cells(LR, 1)), Cells(k, 1), Range(Cells(k, 2), Cells(LR, 2)), Cells(k, 2))
    Cells(t + 1, v + 13).Resize(, 10).Value = Cells(k + m, 1).Resize(, 10).Value: v = v + 10
     For m = 1 To x - 1
      Cells(t + 1, v + 13).Resize(, 8).Value = Cells(k + m, 3).Resize(, 8).Value: v = v + 8
     Next m
    k = k + x - 1: t = t + 1: v = 0: m = 0
   Next k
End Sub

 

[2avrham]

Thanks a lot it is exactly what I meant!

One more question how can I edit above VB code for table with more than 10 columns?

 

[2avrham]

Dim LR As Long, k As Long, x As Long, m As Long, t As Long, v As Long
LR = Cells(Rows.Count, 1).End(3).Row
For k = 2 To LR
x = Application.CountIfs(Range(Cells(k, 1), Cells(LR, 1)), Cells(k, 1), Range(Cells(k, 2), Cells(LR, 2)), Cells(k, 2))
Cells(t + 1, v + 13).Resize(, 11).Value = Cells(k + m, 1).Resize(, 11).Value: v = v + 11
For m = 1 To x - 1
Cells(t + 1, v + 13).Resize(, 9).Value = Cells(k + m, 3).Resize(, 9).Value: v = v + 9
Next m
k = k + x - 1: t = t + 1: v = 0: m = 0
Next k
End Sub

for one more cell, right?