Converting Vertical data to Selected Horizontal data

[Jwgnwa]

Hi All...I am certainly not a master VBA'r, and I cannot find a way to solve the following problem.

I start with a 2 column data set of varying lengths. Column A has Product codes and Column B has Product information. One of the codes is "PN" in column A, this "PN" indicates the start of a new Part Number. The rows following this "PN" have information relating to that Part Number. The number of rows vary depending on the part. Then when the row after the first "PN" has code "PN" this begins a new part number and information so on and so on until there is a blank row. There could be 3 parts or 1,000 parts and the length of the initial 2 column dataset could be 10 rows or 10,000

Column A	Column B
PN	12345
PD	Desk
SP	100.00
BP	75.00
QT	2
OB	87
WT	75
PN	98765
PD	Shelf
BP	35.00
MC	R101
PN	99999
PD	Part
QT	4

<tbody>
</tbody>

Now the problem is that I need to copy each part number and the following required part information for that part number (Just the data from Column B) onto rows in Sheet 2. Sheet 2 is laid out with each required code on the columns as headers for the data. (If Column A on the vertical dataset has a code that is not shown as headers on Sheet 2, the data is not needed and not copied to Sheet 2)So the data for the codes must be copied into the correct column header in Sheet 2. Every Part will have a PN (Part Number) and a PD (Part Description)

​

PN	PD	SP	QT	SP	BP	MG	OL	MC	DT
12345	Desk	100.00	2		70.00		Oak
98765	Shelf				35.00			R101
99999	Part
ETC.	ETC.	ETC.	ETC.	ETC.	ETC.	ETC.	ETC.	ETC.	ETC.

<tbody>
</tbody>

I need to have each part number laid out horizontally so that I can import the data for all the parts into QuickBooks.

I have exhausted my limited VBA knowledge after trying to solve this for weeks. I am hoping this is a simple problem and I am just not seeing it. Thanks for your help

 

[Tom.Jones]

Hello,

I would like you to help me with a similar problem.

If posting here is not appropriate, ask a moderator to move it to a new post. Eventually with a new name. Let's say "Rearrange data"

Thank you.


I have a table (I say the table but it is not a real table - with Insert table),

Cod	H1	H2	H3	H4	H5	H6	H7	H8	H9	H10
A1	Tx1	Tx1	Tx1	Tx1	Tx1	Tx1	Tx1	Tx1	Tx1	Tx1
A2	Tx11	Tx11	Tx11	Tx11	Tx11	Tx11	Tx11	Tx11	Tx11	Tx11
A3	Tx21	Tx21	Tx21	Tx21	Tx21	Tx21	Tx21	Tx21	Tx21	Tx21
A4	Tx31	Tx31	Tx31	Tx31	Tx31	Tx31	Tx31	Tx31	Tx31	Tx31
A5	Tx41	Tx41	Tx41	Tx41	Tx41	Tx41	Tx41	Tx41	Tx41	Tx41

<tbody>
</tbody>

which I would like to turn it into

Cod	H	TdTx
A1	H1	Tx1
A1	H2	Tx2
A1	H3	Tx3
A1	H4	Tx4
A1	H5	Tx5
A1	H6	Tx6
A1	H7	Tx7
A1	H8	Tx8
A1	H9	Tx9
A1	H10	Tx10
A2	H1	Tx11
A2	H2	Tx12
A2	H3	Tx13
A2	H4	Tx14
A2	H5	Tx15
A2	H6	Tx16
A2	H7	Tx17
A2	H8	Tx18
A2	H9	Tx19
A2	H10	Tx20
A3	H1	Tx21
A3	H2	Tx22
A3	H3	Tx23
A3	H4	Tx24
A3	H5	Tx25
A3	H6	Tx26
A3	H7	Tx27
A3	H8	Tx28
A3	H9	Tx29
A3	H10	Tx30
A4	H1	Tx31
A4	H2	Tx32
A4	H3	Tx33
A4	H4	Tx34
A4	H5	Tx35
A4	H6	Tx36
A4	H7	Tx37
A4	H8	Tx38
A4	H9	Tx39
A4	H10	Tx40
A5	H1	Tx41
A5	H2	Tx42
A5	H3	Tx43
A5	H4	Tx44
A5	H5	Tx45
A5	H6	Tx46
A5	H7	Tx47
A5	H8	Tx48
A5	H9	Tx49
A5	H10	Tx50

<tbody>
</tbody>

We want formula and if you can and with VBA cod.

Thank you.

 

[sandy666]

this is very easy with PowerQuery

[SIZE=1]// Table1
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Unpivot = Table.UnpivotOtherColumns(Source, {"Cod"}, "Attribute", "Value"),
    Ren = Table.RenameColumns(Unpivot,{{"Attribute", "H"}, {"Value", "TdTx"}})
in
    Ren[/SIZE]

 

[Tom.Jones]

Thank you so much Sandy,

I don't know with PowerQuery, anyway our boss want formula and if possible VBA cod.

Thank you.

 

[sandy666]

sure, good luck

Have a nice day

 

[Tom.Jones]

Someone?

 

[Jwgnwa]

So sorry Peter. The text of the "it's awesome..." message was certainly focused on you. As I said, I had been working on a solution for weeks & you solved it in less than an hour!

The rest of my post was my continual amazement that in this day & time, people like yourself take your time to share your knowledge and help your neighbors with no expectation of return. Thank you and thank all of the moderators & posters for helping those of us in need. Now, I am off to have a large very cold glass of VB.

 

[Rick Rothstein]

@Tom.Jones

See if this macro does what you want...

[table="width: 500"]
[tr]
	[td]Sub RearrangeData()
  Dim R As Long, LR As Range, Data As Variant, HRow As Variant, ColArr As Variant
  Data = Sheets("Sheet1").Range("A1").CurrentRegion
  HRow = Application.Transpose(Sheets("Sheet1").Range("B1").Resize(, UBound(Data, 2) - 1))
  ColArr = Application.Transpose(Evaluate("ROW(2:" & UBound(Data, 2) & ")"))
  For R = 2 To Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    Set LR = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    LR.Resize(UBound(Data, 2) - 1) = Sheets("Sheet1").Cells(R, "A").Value
    LR.Offset(, 1).Resize(UBound(Data, 2) - 1) = HRow
    LR.Offset(, 2).Resize(UBound(Data, 2) - 1) = Application.Transpose(Application.Index(Data, R, ColArr))
  Next
End Sub[/td]
[/tr]
[/table]

 

[DanteAmor]

@Tom.Jones

See if this macro does what you want...

Hi Rick, In the example the OP captured Tx1, Tx2, Tx3 ... I guess it's a typo error. Let's wait for your comments.

Here I put another way:

Sub Vertical_horizontal()
Dim n As Long
 n = Sheets("sheet1").Cells(1, Columns.Count).End(xlToLeft).Column - 1
 For Each c In Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp))
  Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)(2).Resize(n).Value = c.Value
  Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp)(2).Resize(n).Value = Application.Transpose(Sheets("Sheet1").Range("B1").Resize(1, n).Value)
  Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp)(2).Resize(n).Value = Application.Transpose(Sheets("Sheet1").Range("B" & c.Row).Resize(1, n).Value)
 Next
End Sub

 

[Tom.Jones]

@Rick, @Dante,

Both VBA codes work great. Thank you.
And yes, Dante, you're right. The first one with A1 is Tx1, Tx2, Tx3 ... and not Tx1, Tx1, Tx1 ....

Thank you very much.

 

[DanteAmor]

@Rick, @Dante,

Both VBA codes work great. Thank you.
And yes, Dante, you're right. The first one with A1 is Tx1, Tx2, Tx3 ... and not Tx1, Tx1, Tx1 ....

Thank you very much.

I'm glad to help you. Thanks for the feedback.