Converting Multiple Rows to One with Multiple Colums

Closed
Coools65 Posts 1 Registration date Tuesday December 16, 2014 Status Member Last seen December 16, 2014 - Dec 16, 2014 at 04:29 PM
venkat1926 Posts 1864 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Dec 17, 2014 at 02:52 AM
Hello everyone,

Can anyone help me with converting the below example of data in Excel



Many thanks in advance.

1 reply

venkat1926 Posts 1864 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 810
Dec 17, 2014 at 02:52 AM
download the file from

http://speedy.sh/KsYZh/coools-141217.xlsm
enable macro

there is a macro test in vbeditor

run that.

the macro is also repeated here

Sub test()
Dim myformula
Dim class As Range
Dim r As Range, unq As Range, cunq As Range, nname As Range, prod As Range
Dim uprod As Range, cprod As Range
Application.ScreenUpdating = False
Range(Range("A1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete
Set nname = Range(Range("A1"), Range("A1").End(xlDown))
Set prod = nname.Offset(0, 2)
Set r = Range("A1").CurrentRegion
Set unq = Range("A1").End(xlDown).Offset(5, 0)
Set uprod = unq.Offset(0, 2)
nname.AdvancedFilter xlFilterCopy, , unq, True
prod.AdvancedFilter xlFilterCopy, , uprod, True
Set unq = Range(unq.Offset(1, 0), unq.End(xlDown))
Set uprod = unq.Offset(0, 2).Resize(prod.Rows.Count)
uprod.Copy
uprod(1, 1).Offset(-1, -1).PasteSpecial Transpose:=True
uprod.Clear
Set uprod = Range(unq(1, 1).Offset(-1, 1), unq(1, 1).Offset(-1, 1).End(xlToRight))
For Each cunq In unq
For Each cprod In uprod
myformula = "=index(" & r.Columns("d:d").Address & ",match(1,(" & nname.Address & "=" & cunq.Address & ")*(" & prod.Address & "=" & cprod.Address & "),0),1)"
Application.Evaluate (myformula)
Application.Intersect(Rows(cunq.Row), Columns(cprod.Column)) = Application.Evaluate(myformula)
Next
Next
Application.ScreenUpdating = True
MsgBox "macro over. see below data"
End Sub
0