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 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Dec 17, 2014 at 02:52 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Dec 17, 2014 at 02:52 AM
Related:
- Converting Multiple Rows to One with Multiple Colums
- How to delete multiple files on mac - Guide
- Allow multiple downloads chrome - Guide
- How to make multiple selections in photoshop - Guide
- Mpc-hc multiple instances - Guide
- How to share multiple contacts on android - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Dec 17, 2014 at 02:52 AM
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
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
