Modifying Data Format

[22strider]

Hello Friends,

I am preparing data to be imported from Excel (2010) in to our MRP. The system requires data to be presented in certain format. Could you please help me with a code that would present data in the required format? Following table show the input table (present format of the data) and output table (required format).
Information given in column D of Input is optional; it may or may not be present in the input file.

Thanks,
Rajesh

Excel 2010
	A	B	C	D
2		Input
3	Item	VendorID	Vendor Part Number	Vendor description
4	12345	V987	ABCD	sample vendor desc.
5	12345	V567	WXYZ
6	45678	V698	EFGH	sample vendor desc.
7	78956	V987	EHYC
Sheet1

<p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5;color: #161120">

Excel 2010
	A	B	C	D	E
11		OutPut
12	Item	12345
13	CrossReference	V	V987	ABCD	sample vendor desc.
14	CrossReference	V	V567	WXYZ
15	Item	45678
16	CrossReference	V	V698	EFGH	sample vendor desc.
17	Item	78956
18	CrossReference		V987	EHYC
Sheet1

<p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5;color: #161120">

 

[Rick Rothstein]

I think the following macro will do what you want. However, I was not clear on what row your Input data header was on, so I left it at 3 like you showed... to change it, just change the red highlighted number to the row number where your header actually is.

Sub ReformatData()
  Dim X As Long, LastRow As Long, Items As Range, Ar As Range
  Const InputHeaderRow As Long = 3
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For X = LastRow To InputHeaderRow Step -1
    If Cells(X, "A").Value <> Cells(X - 1, "A").Value Then Rows(X).Insert
  Next
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Set Items = Range("A" & InputHeaderRow & ":A" & LastRow).SpecialCells(xlConstants)
  For Each Ar In Items.Areas
    Ar(1).Offset(-1).Resize(, 4) = Array("Item", Ar(1), "", "")
    Ar.Resize(, 4).Cut Ar.Offset(, 1).Resize(, 4)
    Ar.Offset(, -1).Resize(, 2) = Array("CrossReference", "V")
  Next
  Cells(LastRow, "B").ClearContents
  Columns("A:E").AutoFit
End Sub

 

[22strider]

Hello Rick,

Thanks for the code; it works. My header row is row number 1. I tried running the code by replacing 3 with 1 but it gave me error. The other feedback is that the out put has additional set (2) rows on the top of the table. As shown in the table below, first 2 rows are not required.

Thanks again;
Rajesh

Excel 2010
	A	B	C	D	E	F
3	Item	Item
4	CrossReference	V	VendorID	Vendor Part Number	Vendor description
5	Item	12345
6	CrossReference	V	V987	ABCD	sample vendor desc.
7	CrossReference	V	V567	WXYZ
8	Item	45678
9	CrossReference	V	V698	EFGH	sample vendor desc.
10	Item	78956
11	CrossReference		V987	EHYC
Sheet1

<p style="width:3.6em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5;color: #161120">

 

[Rick Rothstein]

Hello Rick,

Thanks for the code; it works. My header row is row number 1. I tried running the code by replacing 3 with 1 but it gave me error. The other feedback is that the out put has additional set (2) rows on the top of the table. As shown in the table below, first 2 rows are not required.

Okay, knowing for sure that your header row is 1 helps. Give this modified code a try...

Sub ReformatData()
  Dim X As Long, LastRow As Long, Items As Range, Ar As Range
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  For X = LastRow To 3 Step -1
    If Cells(X, "A").Value <> Cells(X - 1, "A").Value Then Rows(X).Insert
  Next
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Set Items = Range("A2" & ":A" & LastRow).SpecialCells(xlConstants)
  For Each Ar In Items.Areas
    Ar(1).Offset(-1).Resize(, 4) = Array("Item", Ar(1), "", "")
    Ar.Resize(, 4).Cut Ar.Offset(, 1).Resize(, 4)
    Ar.Offset(, -1).Resize(, 2) = Array("CrossReference", "V")
  Next
  Cells(LastRow, "B").ClearContents
  Columns("A:E").AutoFit
End Sub

 

[22strider]

Thank you very much; worked like a charm