VBA ReORG Data

[Stephen_IV]

Good Afternoon, I have a report that comes out of a certain system the same way all of the time. The sample below is a small snip-it of a much larger spreadsheet. What I am trying to do is to take a large file and reorg it on sheet 2 with the columns just like below. The 1st shot on the HTML maker shows how the data gets exported out. The 2nd shot on the HTML maker is what I am looking for. I am looking for code because I pull this report every week and want to make it user friendly. Tried a macro but it is a mess. Can someone please help me with some neater code!

Thanks in advance Stephen!

{ID,Name,Date,Subject,Score 1,Score 2,Score 3, Score 4, Score 5, Score 6, Score 7}

Book2
	A	B	C	D	E	F	G	H	I	J	K
1	Date	Name	ID	Subject	Score 7	Score 6	Score 5	Score 4	Score 3	Score 2	Score 1
2	4/2/2011	Sam	83883	Biology	98	98	72	60	72	64	60
3	4/3/2011	Sam	72772	English	72	72	72	60	81	54	60
4	4/4/2011	Steve	16716	Biology	72	72	72	47	89	98	47
5	4/5/2011	Steve	28927	Physics	81	81	81	47	14	72	47
6	4/6/2011	Keith	38736	English	89	89	89	64	14	72	64
7	4/7/2011	Keith	49878	English	14	14	14	64	56	81	64
8	4/8/2011	Al	44332	Physics	14	98	14	81	68	89	54
9	4/9/2011	Al	56555	English	56	72	56	89	98	14	98
10	4/10/2011	Mark	87654	Physics	68	72	68	14	72	14	72
11	4/11/2011	Mark	12123	Biology	72	81	54	14	72	56	72
12	4/12/2011	Fred	12124	Physics	81	89	98	56	81	68	81
13	4/13/2011	Fred	12125	English	89	14	72	68	89	60	89
14	4/14/2011	Peter	12126	English	14	14	72	60	14	60	14
15	4/15/2011	Peter	12127	Physics	14	56	81	60	14	47	14
16	4/16/2011	Peter	12128	English	56	68	54	47	56	47	56
17	4/17/2011	Peter	12129	Physics	68	56	98	47	68	64	68
Sheet1

To this

Book2
	A	B	C	D	E	F	G	H	I	J	K
1	ID	Name	Date	Subject	Score 1	Score 2	Score 3	Score 4	Score 5	Score 6	Score 7
2	83883	Sam	4/2/2011	Biology	60	64	72	60	72	98	98
3	72772	Sam	4/3/2011	English	60	54	81	60	72	72	72
4	16716	Steve	4/4/2011	Biology	47	98	89	47	72	72	72
5	28927	Steve	4/5/2011	Physics	47	72	14	47	81	81	81
6	38736	Keith	4/6/2011	English	64	72	14	64	89	89	89
7	49878	Keith	4/7/2011	English	64	81	56	64	14	14	14
8	44332	Al	4/8/2011	Physics	54	89	68	81	14	98	14
9	56555	Al	4/9/2011	English	98	14	98	89	56	72	56
10	87654	Mark	4/10/2011	Physics	72	14	72	14	68	72	68
11	12123	Mark	4/11/2011	Biology	72	56	72	14	54	81	72
12	12124	Fred	4/12/2011	Physics	81	68	81	56	98	89	81
13	12125	Fred	4/13/2011	English	89	60	89	68	72	14	89
14	12126	Peter	4/14/2011	English	14	60	14	60	72	14	14
15	12127	Peter	4/15/2011	Physics	14	47	14	60	81	56	14
16	12128	Peter	4/16/2011	English	56	47	56	47	54	68	56
17	12129	Peter	4/17/2011	Physics	68	64	68	47	98	56	68
Sheet2

 

[hiker95]

Stephen_IV,


Sample worksheets before the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K
1	Date	Name	ID	Subject	Score 7	Score 6	Score 5	Score 4	Score 3	Score 2	Score 1
2	4/2/2011	Sam	83883	Biology	98	98	72	60	72	64	60
3	4/3/2011	Sam	72772	English	72	72	72	60	81	54	60
4	4/4/2011	Steve	16716	Biology	72	72	72	47	89	98	47
5	4/5/2011	Steve	28927	Physics	81	81	81	47	14	72	47
6	4/6/2011	Keith	38736	English	89	89	89	64	14	72	64
7	4/7/2011	Keith	49878	English	14	14	14	64	56	81	64
8	4/8/2011	Al	44332	Physics	14	98	14	81	68	89	54
9	4/9/2011	Al	56555	English	56	72	56	89	98	14	98
10	4/10/2011	Mark	87654	Physics	68	72	68	14	72	14	72
11	4/11/2011	Mark	12123	Biology	72	81	54	14	72	56	72
12	4/12/2011	Fred	12124	Physics	81	89	98	56	81	68	81
13	4/13/2011	Fred	12125	English	89	14	72	68	89	60	89
14	4/14/2011	Peter	12126	English	14	14	72	60	14	60	14
15	4/15/2011	Peter	12127	Physics	14	56	81	60	14	47	14
16	4/16/2011	Peter	12128	English	56	68	54	47	56	47	56
17	4/17/2011	Peter	12129	Physics	68	56	98	47	68	64	68
18
Sheet1

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sheet2

After the macro:

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K
1	ID	Name	Date	Subject	Score 1	Score 2	Score 3	Score 4	Score 5	Score 6	Score 7
2	83883	Sam	4/2/2011	Biology	60	64	72	60	72	98	98
3	72772	Sam	4/3/2011	English	60	54	81	60	72	72	72
4	16716	Steve	4/4/2011	Biology	47	98	89	47	72	72	72
5	28927	Steve	4/5/2011	Physics	47	72	14	47	81	81	81
6	38736	Keith	4/6/2011	English	64	72	14	64	89	89	89
7	49878	Keith	4/7/2011	English	64	81	56	64	14	14	14
8	44332	Al	4/8/2011	Physics	54	89	68	81	14	98	14
9	56555	Al	4/9/2011	English	98	14	98	89	56	72	56
10	87654	Mark	4/10/2011	Physics	72	14	72	14	68	72	68
11	12123	Mark	4/11/2011	Biology	72	56	72	14	54	81	72
12	12124	Fred	4/12/2011	Physics	81	68	81	56	98	89	81
13	12125	Fred	4/13/2011	English	89	60	89	68	72	14	89
14	12126	Peter	4/14/2011	English	14	60	14	60	72	14	14
15	12127	Peter	4/15/2011	Physics	14	47	14	60	81	56	14
16	12128	Peter	4/16/2011	English	56	47	56	47	54	68	56
17	12129	Peter	4/17/2011	Physics	68	64	68	47	98	56	68
18
Sheet2

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Option Base 1
Sub ReorgColumns()
' hiker95, 04/25/2011
' http://www.mrexcel.com/forum/showthread.php?t=545968
Dim w1 As Worksheet, w2 As Worksheet
Dim wary, a As Long, FC As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Sheet2!A1)") Then Worksheets.Add(After:=w1).Name = "Sheet2"
Set w2 = Worksheets("Sheet2")
w2.UsedRange.Clear
wary = Array("ID", "Name", "Date", "Subject", "Score 1", "Score 2", "Score 3", "Score 4", "Score 5", "Score 6", "Score 7")
For a = LBound(wary) To UBound(wary)
  FC = Application.Match(wary(a), w1.Rows(1), 0)
  w1.Columns(FC).Copy w2.Columns(a)
Next a
w2.Activate
Application.ScreenUpdating = True
End Sub

Then run the ReorgColumns macro.

 

[Stephen_IV]

hiker95,

Absolutly Perfect! Thanks you again for your assistance!