VBA-Reorganise data

[Jemma Atkinson]

Hi, i am after a VBA code that will produce result as shown in sheet After. I do not want the code to create sheet"After". The sheet is already established.

I need the code to apply the following rules.

1. If the Security code is the same as shown in row 21 and 22 in Sheet("After") then subtotal the unit holding.

2. If Security is different but the the first word in the description is the same then group the descriptions together but do not add subtotal to unit holdings, so we can see this by example of Cogent, Gala, Gas.

Else leave security and description on single row as shown by ZZZZZ.

3. I need the code to do Statement - Unitholding calc, but if there is a subtotal then do Statement -Subtotal as shown in F23

I would prefer the After sheet to be in A-Z order by description

Excel Workbook
	A	B	C	D	E	F	G
5	Security	Pfolio	Code Long Name	Location	Stock Exchange	Maturity Date	Unit Holding
6	ABPORT	WTEHYF	ADMIRAL ACQUISTIONS UK	PHX	GB0	14-Aug-14	32,666,666.00
7	ACI1113	WSTAHY	NORWAY CORRECTIONAL INVESTMENT 161113 FRN	PHY	AU0	7-Apr-17	6,582,658.00
8	ACI1113	WSTBFA	NORWAY CORRECTIONAL INVESTMENT 161113 FRN	PHY	AU0	7-Apr-17	4,076,845.00
9	COGCFAC	PISFUL	COGENT CREDIT FACILITY 311011 FULCRUM MEDIA FINANCE 2 PTY LT	PHX	OTC	31-Oct-11	1,884,983.83
10	COGCFAC1	PISFUL	COGENT CREDIT FACILITY 3112 FULCRUM MEDIA FINANCE 2 PTY LT 1	PHX	OTC	31-Dec-20	- 20,000,000.00
11	GALAB	WTEHYF	GALA ELECTRIC CASINOS	PHX	GB0	28-Oct-13	3,327,464.79
12	GALAB1	WTEHYF	GALA ELECTIC CASINOS 1	PHX	GB0	28-Oct-13	3,339,435.30
13	GALAB2	WTEHYF	GALA ELECTRIC CASINOS	PHX	GB0	28-Oct-13	2,912,369.98
14	GALAC	WTEHYF	GALA ELECTRIC CASINOS	PHX	GB0	27-Oct-14	3,295,836.24
15	GALAC1	WTEHYF	GALA ELECTIRC CASINOS 1	PHX	GB0	27-Oct-14	3,415,379.12
16	GALAC2	WTEHYF	GALA ELECTRIC CASINOS	PHX	GB0	27-Oct-14	2,868,711.47
17	GFC0414	1ANXXE	GAS AND FUEL CORPORATION OF VICTORIA 010414 8.90 CB	PHY	AU0	1-Apr-14	1,000,000.00
18	GFC0916	1ANXXE	GAS AND FUEL CORPORATION OF VICTORIA 010916 CB	PHY	AU0	1-Sep-16	1,000,000.00
19	ZZZZZZZ	TESTING	JOE BLOGGS	PHY	USD	1-Apr-14	242,344.36
20
21
22
Before

Excel Workbook
	A	B	C	D	E	F
5	Security	Pfolio	Description	Unit Holding	Statement	Difference
6	COGCFAC	PISFUL	COGENT CREDIT FACILITY 311011 FULCRUM MEDIA FINANCE 2 PTY LT	1,884,983.83		- 1,884,983.83
7	COGCFAC1	PISFUL	COGENT CREDIT FACILITY 3112 FULCRUM MEDIA FINANCE 2 PTY LT 1	- 20,000,000.00		20,000,000.00
8
9	GALAB	WTEHYF	GALA ELECTRIC CASINOS	3,327,464.79		- 3,327,464.79
10	GALAB1	WTEHYF	GALA ELECTIC CASINOS 1	3,339,435.30		- 3,339,435.30
11	GALAB2	WTEHYF	GALA ELECTRIC CASINOS	2,912,369.98		- 2,912,369.98
12	GALAC	WTEHYF	GALA ELECTRIC CASINOS	3,295,836.24		- 3,295,836.24
13	GALAC1	WTEHYF	GALA ELECTIRC CASINOS 1	3,415,379.12		- 3,415,379.12
14	GALAC2	WTEHYF	GALA ELECTRIC CASINOS	2,868,711.47		- 2,868,711.47
15
16	GFC0414	1ANXXE	GAS AND FUEL CORPORATION OF VICTORIA 010414 8.90 CB	1,000,000.00		- 1,000,000.00
17	GFC0916	1ANXXE	GAS AND FUEL CORPORATION OF VICTORIA 010916 CB	1,000,000.00		- 1,000,000.00
18
19	ZZZZZZZ	TESTING	JOE BLOGGS	242,344.36		- 242,344.36
20
21	ACI1113	WSTAHY	AUSTRALIAN CORRECTIONAL INVESTMENT 161113 FRN	6,582,658.00
22	ACI1113	WSTBFA	AUSTRALIAN CORRECTIONAL INVESTMENT 161113 FRN	4,076,845.00
23				10,659,503.00		- 10,659,503.00
24
25
After

 

[Jemma Atkinson]

*bump*

 

[Jemma Atkinson]

*bump*

 

[cgcamal]

Hi Jemma,

Which Excel version do you have?

Regards

 

[Jemma Atkinson]

Hi Jemma,

Which Excel version do you have?

Regards

I have 2002

 

[Peter_SSs]

Unable to test in 2002, but try this in a copy of your workbook.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange_Data()<br>    <SPAN style="color:#00007F">Dim</SPAN> wsB <SPAN style="color:#00007F">As</SPAN> Worksheet, wsA <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> rws <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>, LR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> bDone <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> f <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    <SPAN style="color:#00007F">Const</SPAN> FirstRw <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 5 <SPAN style="color:#007F00">'<-- Change to suit header row</SPAN><br>    <SPAN style="color:#00007F">Const</SPAN> fBase1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "=SUMIF(R#C1:R[-1]C1,R[-1]C1,R#C4:R[-1]C4)"<br>    <SPAN style="color:#00007F">Const</SPAN> fBase2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "=IF(A#="""",E#-D#,IF(COUNTIF(A$#:A$^,A#)=1,E#-D#,""""))"<br>    <br>    f = Replace(fBase1, "#", FirstRw)<br>    <SPAN style="color:#00007F">Set</SPAN> wsB = Sheets("Before")<br>    <SPAN style="color:#00007F">Set</SPAN> wsA = Sheets("After")<br>    rws = wsB.Range("A" & wsB.Rows.Count).End(xlUp).Row - FirstRw + 1<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> wsA<br>        .Rows(FirstRw & ":" & .Rows.Count).ClearContents<br>        .Cells(FirstRw, 1).Resize(rws, 3).Value = _<br>            wsB.Cells(FirstRw, 1).Resize(rws, 3).Value<br>        .Cells(FirstRw, 4).Resize(rws).Value = _<br>            wsB.Cells(FirstRw, 7).Resize(rws).Value<br>        .Cells(FirstRw, 1).Resize(rws, 4).Sort _<br>            Key1:=.Cells(FirstRw + 1, 3), Order1:=xlAscending, Header:=xlYes, _<br>            OrderCustom:=1, MatchCase:=False, Orientation:=xlTop<SPAN style="color:#00007F">To</SPAN>Bottom, _<br>            DataOption1:=xlSortNormal<br>        <SPAN style="color:#00007F">For</SPAN> r = FirstRw + rws - 1 To FirstRw + 2 <SPAN style="color:#00007F">Step</SPAN> -1<br>            <SPAN style="color:#00007F">If</SPAN> .Cells(r, 1).Value = .Cells(r - 1, 1).Value <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> bDone <SPAN style="color:#00007F">Then</SPAN><br>                    .Rows(r + 1).Insert<br>                    .Cells(r + 1, 4).FormulaR1C1 = f<br>                    bDone = <SPAN style="color:#00007F">True</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Else</SPAN><br>                bDone = <SPAN style="color:#00007F">False</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> r<br>        LR = .Range("D" & .Rows.Count).End(xlUp).Row<br>        <SPAN style="color:#00007F">With</SPAN> .Range("F" & FirstRw + 1 & ":F" & LR)<br>            .Formula = Replace(Replace(fBase2, "#", FirstRw + 1), "^", LR)<br>            .Value = .Value<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</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>

 

[Jemma Atkinson]

Peter, almost there, i require there to be a single row gap between each data set as shown in "After" worksheet in #1.

Also can the code put header "Statement" and "Difference" in sheet "After" and have all numerical data as the below format

.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

 

[Peter_SSs]

Peter, almost there, i require there to be a single row gap between each data set as shown in "After" worksheet in #1.

Sorry, I did miss that but before doing that I have a couple of questions ..

1. I have sorted the data on column C which I think is what you want, but what's the situation with NORWAY in 'Before' becoming 'AUSTRALIAN' in 'After'?

2. In relation to the blank row and referring to your 'After' screen shot in post #1:
Can you clarify what happens after a 'group' like the last 2 items in 'After'. If there was more data below that would it go in row 24 leaving a blank row in columns A:C or would it go in row 25 leaving 2 blank rows in A:C and a single blank row in col D?

Also can the code put header "Statement" and "Difference" in sheet "After" and have all numerical data as the below format

.NumberFormat = "#,##0.00_);[Red](#,##0.00)"

You have been involved in quite a lot of (often quite lengthy) threads about vba. Couln't you have a go at these bits yourself?

 

[Jemma Atkinson]

Peter, With the Australian and Norway i was just doing some testing, the actual data reads Norway.

With the gaps there must be always a single row gap between column D and the next set of data, so something like this if there was a subtotal. I will fix up the number formatting.

Excel Workbook
	A	B	C	D	E	F
23	ACI1113	WSTAHY	NORWAY CORRECTIONAL INVESTMENT 161113 FRN	6,582,658.00
24	ACI1113	WSTBFA	NORWAY CORRECTIONAL INVESTMENT 161113 FRN	4,076,845.00
25				10,659,503.00		- 10,659,503.00
26
27
After

 

[Peter_SSs]

Try this version.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange_Data()<br>    <SPAN style="color:#00007F">Dim</SPAN> wsB <SPAN style="color:#00007F">As</SPAN> Worksheet, wsA <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> rws <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>, LR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, p <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> bDone <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> f <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, s1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, s2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    <SPAN style="color:#00007F">Const</SPAN> FirstRw <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 5 <SPAN style="color:#007F00">'<-- Change to suit header row</SPAN><br>    <SPAN style="color:#00007F">Const</SPAN> fBase1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = _<br>        "=SUMIF(R#C1:R[-1]C1,R[-1]C1,R#C4:R[-1]C4)"<br>    <SPAN style="color:#00007F">Const</SPAN> fBase2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = _<br>        "=IF(AND(A#="""",D#<>""""),E#-D#,IF(COUNTIF(A$#:A$^,A#)=1,E#-D#,""""))"<br>    <br>    f = Replace(fBase1, "#", FirstRw)<br>    <SPAN style="color:#00007F">Set</SPAN> wsB = Sheets("Before")<br>    <SPAN style="color:#00007F">Set</SPAN> wsA = Sheets("After")<br>    rws = wsB.Range("A" & wsB.Rows.Count).End(xlUp).Row - FirstRw + 1<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> wsA<br>        .Rows(FirstRw & ":" & .Rows.Count).ClearContents<br>        .Cells(FirstRw, 1).Resize(rws, 3).Value = _<br>            wsB.Cells(FirstRw, 1).Resize(rws, 3).Value<br>        .Cells(FirstRw, 4).Resize(rws).Value = _<br>            wsB.Cells(FirstRw, 7).Resize(rws).Value<br>        .Cells(FirstRw, 1).Resize(rws, 4).Sort _<br>            Key1:=.Cells(FirstRw + 1, 3), Order1:=xlAscending, Header:=xlYes, _<br>            OrderCustom:=1, MatchCase:=False, Orientation:=xlTop<SPAN style="color:#00007F">To</SPAN>Bottom, _<br>            DataOption1:=xlSortNormal<br>        <SPAN style="color:#00007F">For</SPAN> r = FirstRw + rws - 1 To FirstRw + 2 <SPAN style="color:#00007F">Step</SPAN> -1<br>            <SPAN style="color:#00007F">If</SPAN> .Cells(r, 1).Value = .Cells(r - 1, 1).Value <SPAN style="color:#00007F">Then</SPAN><br>                <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> bDone <SPAN style="color:#00007F">Then</SPAN><br>                    .Rows(r + 1).Resize(2).Insert<br>                    .Cells(r + 1, 4).FormulaR1C1 = f<br>                    bDone = <SPAN style="color:#00007F">True</SPAN><br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Else</SPAN><br>                bDone = <SPAN style="color:#00007F">False</SPAN><br>                s1 = .Cells(r, 3).Value & " "<br>                s2 = .Cells(r + 1, 3).Value & " "<br>                p = InStr(1, s1, " ")<br>                <SPAN style="color:#00007F">If</SPAN> Left(s1, p) <> Left(s2, p) <SPAN style="color:#00007F">Then</SPAN><br>                    .Rows(r + 1).Insert<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN> r<br>        LR = .Range("D" & .Rows.Count).End(xlUp).Row<br>        <SPAN style="color:#00007F">With</SPAN> .Range("F" & FirstRw + 1 & ":F" & LR)<br>            .Formula = Replace(Replace(fBase2, "#", FirstRw + 1), "^", LR)<br>            .Value = .Value<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        .Columns("A:F").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>