Transpose - repeat until change

[jmh2008]

I have an excel spreadsheet with member names and a history of all they share purchases. The row Labels are:

Last name | First Name | Purchase 1 | Purchase 2 | Purchase 3| Purchase Date 1 | Purchase date 2 | Purchase date 3

Purchases equal the Amount, which corresponds to the Date, ie

Purchase 1 = Purchase Date 1
Purchase 2 - Purchase Date 2,
etc

I want to have the following so I can import to Access: (Not all members purchase the same amount)

Last name | First name | Purchase Dates | Amount
Joe Brown may 1, 2011 10
Joe Brown Oct 2,, 2010 10
Joe Brown Feb 11, 2007 10
Mary Smith July 1, 2000 10
Frank Jones Nov 1, 2000 10
Frank Jones March 4, 1999 10

Thanks!!

 

[jmh2008]

Sorry, you are correct,

1. they are Column headings.
2. I was going to give them a unique number identifier, but original spreadsheet does not have this.
3. Yes, I hope!
4. Shares Purchase = Date Purchase (members need to buy 10 shares to have a "full" share membership, therefore 10 Shares dates and 10 share purchase columns)

Thanks for all the references for VBA, so much VBA, so little time

cheers,
Juanita


First Name, Last name are the

1. Please confirm they are column labels, not row labels?

2. The first column heading (Number) seems to have disappeared so the results will only be 4 columns (First Name, Last Name, Amount, Date) or will all the left hand columns need to be repeated?

3. Is this just a one-off job?

4. If the answer to 3 is 'No', is the number of 'Share'/'Date' columns always the same (10 in your current example)?

5. If the anwer to 4 is 'No', ..
- do the 'Share' columns always start in a particular column (eg col AC)?
- are the 'Date' columns always followed by just one other column?

 

[Peter_SSs]

First Name, Last name are the

What happened here? Was this the start of answering the balance of Q2? Will there be 4 columns or lots in the final sheet?

 

[jmh2008]

What happened here? Was this the start of answering the balance of Q2? Will there be 4 columns or lots in the final sheet?

The final result sheet will be 4 columns.

Last Name, First name, Purchase date, Amount

Thanks
Juanita

 

[Peter_SSs]

The final result sheet will be 4 columns.

Last Name, First name, Purchase date, Amount

Thanks
Juanita

I haven't swapped the order of the Last name/First name columns or the Date/Amount columns as this appears to suggest since you haven't specifically mentioned that. See how this goes.

Edit the code if the first 'Share' column is not column AC.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange_Data()<br>    <SPAN style="color:#00007F">Dim</SPAN> fc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, fr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, fsc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Const</SPAN> FirstShareCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "AC" <SPAN style="color:#007F00">'<- Change to suit</SPAN><br>    <SPAN style="color:#00007F">Const</SPAN> cols <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 10 <SPAN style="color:#007F00">'<- No of Share & Date cols (each)</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    fsc = Columns(FirstShareCol).Column<br>    ActiveSheet.Copy After:=ActiveSheet<br>    <SPAN style="color:#00007F">With</SPAN> ActiveSheet<br>        fc = .Cells(1, .Columns.Count).End(xlToLeft).Column + 2<br>        .Cells(1, fc).Resize(, 4).Value = _<br>            Array("Last Name", "First name", "Amount", "Date")<br>        LR = .Cells(.Rows.Count, 1).End(xlUp).Row<br>        fr = 2<br>        <SPAN style="color:#00007F">For</SPAN> r = 2 <SPAN style="color:#00007F">To</SPAN> LR<br>            .Cells(fr, fc + 2).Resize(cols).Value = _<br>                Application.Transpose(.Cells(r, fsc).Resize(, cols).Value)<br>            .Cells(fr, fc + 3).Resize(cols).Value = _<br>                Application.Transpose(.Cells(r, fsc + cols).Resize(, cols).Value)<br>            rws = .Cells(.Rows.Count, fc + 2).End(xlUp).Row - fr + 1<br>            .Cells(fr, fc).Resize(rws, 2).Value = .Cells(r, 1).Resize(, 2).Value<br>            fr = fr + rws<br>        <SPAN style="color:#00007F">Next</SPAN> r<br>        .Columns("A").Resize(, fc - 1).Delete<br>        .Columns("A:D").AutoFit<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[jmh2008]

I get an Error 400

when I try the debug it highlights Sub Rearrange_Data()

 

[Peter_SSs]

I get an Error 400

when I try the debug it highlights Sub Rearrange_Data()

When you report an error, it is always best if you can report the full error as it gives more to go on.

In this case my best guess is that you didn't replace the previous code with this code but pasted this code in separately (though that would normally give a differentb error). In that case you would have 2 subs with the same name, which isn't allowed. So remove the old code or re-name one of the 'duplicate' subs.

If that is not the problem, post the whole error message to see if that gives any more hints.

 

[jmh2008]

I copied my data to a new workbook and saved it as a new name. Then copied the code. When I ran the macro I got error"
"Run time error "1004"
application defined or object defined error.

and it highlighted the line:

.Cells(fr, fc).Resize(rws, 2).Value = .Cells(r, 1).Resize(, 2).Value

I did change the "AC" to "AB" which is where my first column label for "Shares" started.

 

[Peter_SSs]

I did change the "AC" to "AB" which is where my first column label for "Shares" started.

Does that mean you have removed one of the columns you listed before?

Excel Workbook
	A	B
1	FirstName	A
2	Lastname	B
3	StreetAddress	C
4	City	D
5	State	E
6	Zip	F
7	MainPhone	G
8	MainEmail	H
9	Share Notes	I
10	Notes	J
11	MembershipDate	K
12	MembershipStatus	L
13	Join Notes	M
14	ExpirationDate	N
15	Share In Full	O
16	Dues	P
17	Category	Q
18	League	R
19	Day	S
20	Men's	T
21	Ladies	U
22	Mixed	V
23	Open	W
24	Social	X
25	Juniors	Y
26	Volunteer	Z
27	Past Member	AA
28	Title	AB
29	Share1	AC
30	Share2	AD
31	Share3	AE
32	Share4	AF
33	Share5	AG
34	Share6	AH
35	Share7	AI
36	Share8	AJ
37	Share9	AK
38	Share10	AL
39	Date1	AM
40	Date2	AN
41	Date3	AO
42	Date4	AP
43	Date5	AQ
44	Date6	AR
45	Date7	AS
46	Date8	AT
47	Date9	AU
48	Date10	AV
49	Total Shares Paid	AW
Column Letters

I copied my data to a new workbook and saved it as a new name. Then copied the code. When I ran the macro I got error"
"Run time error "1004"
application defined or object defined error.

and it highlighted the line:

.Cells(fr, fc).Resize(rws, 2).Value = .Cells(r, 1).Resize(, 2).Value

Re-run the code and when you get the error, click Debug then hover your cursor over each of the variable names listed below and report their values.

fr =
fc =
rws =
r =

I'll again take a stab at a possible cause. My guess is that the 'rws' value will be 0. That would indicate row (whatever r = ?) within the data area has no values at all in any of the 'Share' columns? Is that correct/possible? If so we can adjust the code once we know if that is likely the issue.

 

[jmh2008]

Yes, rws = 0, some members have not paid for shares yet, therefore, this would be blank.

fr = 157
fc = 51
rws = 0
r = 18

 

[Peter_SSs]

Try this then

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange_Data()<br>    <SPAN style="color:#00007F">Dim</SPAN> fc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, fr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, fsc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Const</SPAN> FirstShareCol <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "AB" <SPAN style="color:#007F00">'<- Change to suit</SPAN><br>    <SPAN style="color:#00007F">Const</SPAN> cols <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 10 <SPAN style="color:#007F00">'<- No of Share & Date cols (each)</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    fsc = Columns(FirstShareCol).Column<br>    ActiveSheet.Copy After:=ActiveSheet<br>    <SPAN style="color:#00007F">With</SPAN> ActiveSheet<br>        fc = .Cells(1, .Columns.Count).End(xlToLeft).Column + 2<br>        .Cells(1, fc).Resize(, 4).Value = _<br>            Array("Last Name", "First name", "Amount", "Date")<br>        LR = .Cells(.Rows.Count, 1).End(xlUp).Row<br>        fr = 2<br>        <SPAN style="color:#00007F">For</SPAN> r = 2 <SPAN style="color:#00007F">To</SPAN> LR<br>            .Cells(fr, fc + 2).Resize(cols).Value = _<br>                Application.Transpose(.Cells(r, fsc).Resize(, cols).Value)<br>            rws = .Cells(.Rows.Count, fc + 2).End(xlUp).Row - fr + 1<br>            <SPAN style="color:#00007F">If</SPAN> rws > 0 <SPAN style="color:#00007F">Then</SPAN><br>                .Cells(fr, fc + 3).Resize(cols).Value = _<br>                    Application.Transpose(.Cells(r, fsc + cols).Resize(, cols).Value)<br>                .Cells(fr, fc).Resize(rws, 2).Value = .Cells(r, 1).Resize(, 2).Value<br>                fr = fr + rws<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> r<br>        .Columns("A").Resize(, fc - 1).Delete<br>        .Columns("A:D").AutoFit<br>        Application.Goto Reference:="R1C1", Scroll:=<SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>