VBA-Reorganise data

Jemma Atkinson

Jemma Atkinson

Well-known Member
Joined
Jul 7, 2008
Messages
509
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
ABCDEFG
5SecurityPfolioCode Long NameLocationStock ExchangeMaturity DateUnit Holding
6ABPORTWTEHYFADMIRAL ACQUISTIONS UKPHXGB014-Aug-1432,666,666.00
7ACI1113WSTAHYNORWAY CORRECTIONAL INVESTMENT 161113 FRNPHYAU07-Apr-176,582,658.00
8ACI1113WSTBFANORWAY CORRECTIONAL INVESTMENT 161113 FRNPHYAU07-Apr-174,076,845.00
9COGCFACPISFULCOGENT CREDIT FACILITY 311011 FULCRUM MEDIA FINANCE 2 PTY LTPHXOTC31-Oct-111,884,983.83
10COGCFAC1PISFULCOGENT CREDIT FACILITY 3112 FULCRUM MEDIA FINANCE 2 PTY LT 1PHXOTC31-Dec-20- 20,000,000.00
11GALABWTEHYFGALA ELECTRIC CASINOSPHXGB028-Oct-133,327,464.79
12GALAB1WTEHYFGALA ELECTIC CASINOS 1PHXGB028-Oct-133,339,435.30
13GALAB2WTEHYFGALA ELECTRIC CASINOSPHXGB028-Oct-132,912,369.98
14GALACWTEHYFGALA ELECTRIC CASINOSPHXGB027-Oct-143,295,836.24
15GALAC1WTEHYFGALA ELECTIRC CASINOS 1PHXGB027-Oct-143,415,379.12
16GALAC2WTEHYFGALA ELECTRIC CASINOSPHXGB027-Oct-142,868,711.47
17GFC04141ANXXEGAS AND FUEL CORPORATION OF VICTORIA 010414 8.90 CBPHYAU01-Apr-141,000,000.00
18GFC09161ANXXEGAS AND FUEL CORPORATION OF VICTORIA 010916 CBPHYAU01-Sep-161,000,000.00
19ZZZZZZZTESTINGJOE BLOGGSPHYUSD1-Apr-14242,344.36
20
21
22
Before


Excel Workbook
ABCDEF
5SecurityPfolioDescriptionUnit HoldingStatementDifference
6COGCFACPISFULCOGENT CREDIT FACILITY 311011 FULCRUM MEDIA FINANCE 2 PTY LT1,884,983.83- 1,884,983.83
7COGCFAC1PISFULCOGENT CREDIT FACILITY 3112 FULCRUM MEDIA FINANCE 2 PTY LT 1- 20,000,000.0020,000,000.00
8
9GALABWTEHYFGALA ELECTRIC CASINOS3,327,464.79- 3,327,464.79
10GALAB1WTEHYFGALA ELECTIC CASINOS 13,339,435.30- 3,339,435.30
11GALAB2WTEHYFGALA ELECTRIC CASINOS2,912,369.98- 2,912,369.98
12GALACWTEHYFGALA ELECTRIC CASINOS3,295,836.24- 3,295,836.24
13GALAC1WTEHYFGALA ELECTIRC CASINOS 13,415,379.12- 3,415,379.12
14GALAC2WTEHYFGALA ELECTRIC CASINOS2,868,711.47- 2,868,711.47
15
16GFC04141ANXXEGAS AND FUEL CORPORATION OF VICTORIA 010414 8.90 CB1,000,000.00- 1,000,000.00
17GFC09161ANXXEGAS AND FUEL CORPORATION OF VICTORIA 010916 CB1,000,000.00- 1,000,000.00
18
19ZZZZZZZTESTINGJOE BLOGGS242,344.36- 242,344.36
20
21ACI1113WSTAHYAUSTRALIAN CORRECTIONAL INVESTMENT 161113 FRN6,582,658.00
22ACI1113WSTBFAAUSTRALIAN CORRECTIONAL INVESTMENT 161113 FRN4,076,845.00
2310,659,503.00- 10,659,503.00
24
25
After
 
Sort by date Sort by votes
Peter the code did not insert a row between rows 6 and 7.


Excel Workbook
ABCDEF
5 SecurityPfolioCode Long NameUnit Holding
6ABPORT WTEHYFADMIRAL ACQUISTIONS UK 32,666,666.00- 32,666,666.00
7COGCFACPISFULCOGENT CREDIT FACILITY 311011 FULCRUM MEDIA FINANCE 2 PTY LT 1,884,983.83- 1,884,983.83
8COGCFAC1PISFULCOGENT CREDIT FACILITY 3112 FULCRUM MEDIA FINANCE 2 PTY LT 1- 20,000,000.0020,000,000.00
9
After
 
Upvote 0

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Rich (BB code): 
For r = FirstRw + rws - 1 To FirstRw + 1 Step -1
 
Upvote 0
Peter, i've been doing some testing between different data sets and i find the code does not insert a row for the highighted rows in Sheet After

Excel Workbook
ABCDEFG
5 SecurityPfolioCode Long NameLocationStock Exchange Maturity DateUnit Holding
6SHT02191ANXXEOSLO HARBOUR TUNNEL 150219 IAB PHYAU015-Feb-19 5,000,000.00
7SHT02201ANXXEOSLO HARBOR TUNNEL AUTHORITY 150220 IAB PHYAU015-Feb-2010,998,300.00
8SHT02211ANXXEOSLO HARBOR TUNNEL AUTHORITY 150221 IAB PHYAU015-Feb-2115,640,000.00
9SHT02221ANXXEOSLO HARBOR TUNNEL AUTHORITY 150222 IAB PHYAU015-Feb-2223,000,000.00
10SHT0820A1ANXXEOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND PHYAU015-Aug-2016,650,000.00
11SHT08211ANXXEOSLO HARBOR TUNNEL 150821 IAB PHYAU015-Aug-2133,200,000.00
12SHT0822A1ANXXEOSLO HARBOR TUNNEL AUTHORITY 150822 IAB PHYAU015-Aug-2226,400,000.00
13SHT02201GCSXSOSLO HARBOR TUNNEL AUTHORITY 150220 IAB PHYAU015-Feb-20 8,351,700.00
14SHT02211GCSXSOSLO HARBOR TUNNEL AUTHORITY 150221 IAB PHYAU015-Feb-2113,360,000.00
15SHT0820A1GCSXSOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND PHYAU015-Aug-20 8,550,000.00
16SHT0822A1GSXXSOSLO HARBOR TUNNEL AUTHORITY 150822 IAB PHYAU015-Aug-22 1,500,000.00
17SHT02201OGSXOOSLO HARBOR TUNNEL AUTHORITY 150220 IAB PHYAU015-Feb-20 8,200,000.00
18SHT02211OGSXOOSLO HARBOR TUNNEL AUTHORITY 150221 IAB PHYAU015-Feb-2111,000,000.00
19SHT0820A1OGSXOOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND PHYAU015-Aug-20 9,800,000.00
20SHT08211OGSXOOSLO HARBOR TUNNEL 150821 IAB PHYAU015-Aug-211800000
Before


Excel Workbook
ABCDEF
5 SecurityPfolioCode Long NameUnit HoldingStatementDifference
6SHT08211ANXXEOSLO HARBOR TUNNEL 150821 IAB 33,200,000.00
7SHT08211OGSXOOSLO HARBOR TUNNEL 150821 IAB 1800000
835000000-35,000,000.00
9
10SHT02201ANXXEOSLO HARBOR TUNNEL AUTHORITY 150220 IAB 10998300
11SHT02201GCSXSOSLO HARBOR TUNNEL AUTHORITY 150220 IAB 8351700
12SHT02201OGSXOOSLO HARBOR TUNNEL AUTHORITY 150220 IAB 8,200,000.00
1327,550,000.00-27,550,000.00
14
15SHT02211ANXXEOSLO HARBOR TUNNEL AUTHORITY 150221 IAB 15640000
16SHT02211GCSXSOSLO HARBOR TUNNEL AUTHORITY 150221 IAB 13360000
17SHT02211OGSXOOSLO HARBOR TUNNEL AUTHORITY 150221 IAB 11,000,000.00
1840,000,000.00-40,000,000.00
19
20SHT02221ANXXEOSLO HARBOR TUNNEL AUTHORITY 150222 IAB 23000000-23,000,000.00
21SHT0822A1ANXXEOSLO HARBOR TUNNEL AUTHORITY 150822 IAB 26400000
22SHT0822A1GSXXSOSLO HARBOR TUNNEL AUTHORITY 150822 IAB 1,500,000.00
2327,900,000.00-27,900,000.00
24
25SHT02191ANXXEOSLO HARBOUR TUNNEL 150219 IAB 5,000,000.00-5,000,000.00
26SHT0820A1ANXXEOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND 16650000
27SHT0820A1GCSXSOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND 8550000
28SHT0820A1OGSXOOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND 9,800,000.00
2935,000,000.00-35,000,000.00
After
 
Upvote 0
Jemma Atkinson said:
Peter, i've been doing some testing between different data sets and i find the code does not insert a row for the highighted rows in Sheet After
Click to expand...
Your rules are no longer clear to me. For example, rows 25 and 26 above appear to fit this rule:
Jemma Atkinson said:
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, ..
Click to expand...
Their securities are different but their first words are the same so keep them together. Now you say you want them apart. :confused:

The requirements need to be clear, precise consistent and cover all your possible scenarios..
 
Upvote 0
Peter if the securities are the same then they need to be grouped together nothing else should be added to this.

If the securities is different but the first word is the same then put all the data for the different securities which has the first word matching grouped together, but i dont want to add the data where the securities are the same. This is what i expect the macro to do.

Excel Workbook
ABCDEF
5SecurityPfolioCode Long NameUnit Holding
6SHT08211ANXXEOSLO HARBOR TUNNEL 150821 IAB33,200,000.00
7SHT08211OGSXOOSLO HARBOR TUNNEL 150821 IAB1,800,000.00
835,000,000.00-35,000,000.00
9
10SHT02201ANXXEOSLO HARBOR TUNNEL AUTHORITY 150220 IAB10,998,300.00
11SHT02201GCSXSOSLO HARBOR TUNNEL AUTHORITY 150220 IAB8,351,700.00
12SHT02201OGSXOOSLO HARBOR TUNNEL AUTHORITY 150220 IAB8,200,000.00
1327,550,000.00-27,550,000.00
14
15SHT02211ANXXEOSLO HARBOR TUNNEL AUTHORITY 150221 IAB15,640,000.00
16SHT02211GCSXSOSLO HARBOR TUNNEL AUTHORITY 150221 IAB13,360,000.00
17SHT02211OGSXOOSLO HARBOR TUNNEL AUTHORITY 150221 IAB11,000,000.00
1840,000,000.00-40,000,000.00
19
20SHT02221ANXXEOSLO HARBOR TUNNEL AUTHORITY 150222 IAB23,000,000.00-23,000,000.00
21
22SHT0822A1ANXXEOSLO HARBOR TUNNEL AUTHORITY 150822 IAB26,400,000.00
23SHT0822A1GSXXSOSLO HARBOR TUNNEL AUTHORITY 150822 IAB1,500,000.00
2427,900,000.00-27,900,000.00
25
26SHT02191ANXXEOSLO HARBOUR TUNNEL 150219 IAB5,000,000.00-5,000,000.00
27
28SHT0820A1ANXXEOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND16,650,000.00
29SHT0820A1GCSXSOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND8,550,000.00
30SHT0820A1OGSXOOSLO HARBOUR TUNNEL AUTH 150820 INDEX ANNUITY BOND9,800,000.00
3135,000,000.00-35,000,000.00
32
After
 
Upvote 0
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> ctr1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, ctr2 <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> 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>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range<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> = "=SUM(R[-#]C:R[-1]C)"<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>    <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, _<br>            Key2:=.Cells(FirstRw + 1, 1), Order2:=xlAscending, _<br>            Header:=xlYes, OrderCustom:=1, MatchCase:=False, _<br>            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal<br>        <br>        LR = FirstRw + rws<br>        <SPAN style="color:#00007F">Do</SPAN><br>            .Rows(LR).Insert<br>            ctr1 = 1<br>            <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> .Cells(LR - 1, 1).Value = .Cells(LR - 1 - ctr1, 1).Value<br>                ctr1 = ctr1 + 1<br>            <SPAN style="color:#00007F">Loop</SPAN><br>            <SPAN style="color:#00007F">If</SPAN> ctr1 > 1 <SPAN style="color:#00007F">Then</SPAN><br>                .Rows(LR).Insert<br>                .Cells(LR, 4).FormulaR1C1 = Replace(fBase1, "#", ctr1)<br>                LR = LR - ctr1<br>            <SPAN style="color:#00007F">Else</SPAN><br>                bDone = <SPAN style="color:#00007F">False</SPAN><br>                ctr2 = 1<br>                <SPAN style="color:#00007F">Do</SPAN><br>                    s1 = .Cells(LR - ctr2, 3).Value & " "<br>                    s2 = .Cells(LR - ctr2 - 1, 3).Value & " "<br>                    p = InStr(1, s1, " ")<br>                    <SPAN style="color:#00007F">If</SPAN> Left(s1, p) = Left(s2, p) And _<br>                        .Cells(LR - ctr2, 1).Value <> .Cells(LR - ctr2 - 1, 1).Value And _<br>                        .Cells(LR - ctr2 - 1, 1).Value <> .Cells(LR - ctr2 - 2, 1).Value _<br>                            <SPAN style="color:#00007F">Then</SPAN><br>                        ctr2 = ctr2 + 1<br>                    <SPAN style="color:#00007F">Else</SPAN><br>                        LR = LR - ctr2<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">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> <SPAN style="color:#00007F">Not</SPAN> bDone And LR > FirstRw + 1<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> LR > FirstRw + 1<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>
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Move data from one sheet to mutlipe sheets based on sheet name
Replies
3
Views
697
Herakles
H
D
  • Question Question
scraping website using vba excel please help
Replies
0
Views
879
dinesh1master
D
R
  • Locked
  • Question Question
how to copy data from a website
Replies
1
Views
1K
Joe4
Joe4
R
  • Locked
  • Question Question
how to copy data from a website
Replies
1
Views
2K
VoG
VoG
R
  • Question Question
how to copy data from a website to excel
Replies
1
Views
1K
poolhall
poolhall

Forum statistics

Threads
1,225,156
Messages
6,183,238
Members
453,152
Latest member
ChrisMd

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top