I need a vba code

[mljohn]

I have one item number with multiple suppliers and their price for that item in one row.

I need to reformat the data.

Instead of the all prices being in one row I need to have each price in its own row

Now I have:

A1---------G1------H1-------I1-------J1------K1-------L1--------M1
OEM# ----CAU -----IJR ---- Katun ----PE ----Royal-----MSE ---- WestPoint
7671------$42.15----------------------------$20.77---------------------



I would like it formatted to:

A1-----------B1---------------C1
OEM#------VendorPrice-----VendorName
7671-------$42.15-------------CAU
7671-------$20.77-------------Royal


I can't figure how to do this with formulas so I guess I need a VBA code to do this.

Note that the OEM# field will have to be added to each row.

Thanks for your help

Matt

 

[MickG]

Try this:-
Results sheet (2) starts "A1"

[COLOR="Navy"]Sub[/COLOR] MG07Aug36
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ac          [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oHds
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.count).End(xlUp))
    ReDim ray(1 To Rng.count * 6, 1 To 3)
        oHds = Array("OEM#", "Vendor Price", "Vendor Value")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] Ac = 7 To 13
        [COLOR="Navy"]If[/COLOR] Not Dn(, Ac) = vbNullString [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            ray(c, 1) = Dn: ray(c, 2) = Dn(, Ac): ray(c, 3) = Rng(1).Offset(-1, Ac - 1)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1")
    .Resize(, 3) = oHds
    .Offset(1).Resize(c, 3) = ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[mljohn]

Thank you MickG

I works perfectly.

You guys on MrExcel are the best.

I don't totally understand this but I have learned alot from this forum.

Thanks

Matt

 

[MickG]

Your welcome.
Regards Mick