VBA help

I

Isabella

Well-known Member
Joined
Nov 7, 2008
Messages
643
Hi All, i have a work task which i perform every month which i need automating. I have 3 worksheets at present (RawData, SMPJPD15, SMPUB915). From the raw data i will copy data for each unique security (Col B) to its own worksheet and then insert row between each unique portfolio. See below examples:

Ranges are correct as shown in the examples.

Excel Workbook
ABCDEFGHIJK
4PfCodeSecurity Short NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCodeContractDateSettlementDate TransUnits
5RSTAHYSMPJPD15SMP JP 061215 CC 85DS04157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
6RSTAHYSMPJPD15SMP JP 061215 CC 85DS04158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00
7RSTBFASMPJPD15SMP JP 061215 CC 85DS04157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
8RSTBFASMPJPD15SMP JP 061215 CC 85DS04158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00
9RTFDBGSMPJPD15SMP JP 061215 CC 85DS04157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
10RTFDBGSMPJPD15SMP JP 061215 CC 85DS04160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
11RTFDBGSMPJPD15SMP JP 061215 CC 85DS04160457INT INT 31/12/201031/12/20100.00
12RTEYFGSMPUB915SMP UBS 092015 CC 85DS04150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
13RTEYFGSMPUB915SMP UBS 092015 CC 85DS04151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
14RTEYFGSMPUB915SMP UBS 092015 CC 85DS04152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00
15RTFDBGSMPUB915SMP UBS 092015 CC 85DS04154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
16RTFDBGSMPUB915SMP UBS 092015 CC 85DS04155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
17RTFDBGSMPUB915SMP UBS 092015 CC 85DS04158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
18RTFDBGSMPUB915SMP UBS 092015 CC 85DS04159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00
19RSTBFASMPUB915SMP UBS 092015 CC 85DS04160460INT INT 31/12/201031/12/20100.00
20RSTBFASMPUB915SMP UBS 092015 CC 85DS04160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00
RawData



Excel Workbook
ABCDEFGHI
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContract DateSettlementDateTrans Units
6RSTAHYSMPJPD15SMP JP 061215 CC 157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
7RSTAHYSMPJPD15SMP JP 061215 CC 158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00
8
9RSTBFASMPJPD15SMP JP 061215 CC 157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
10RSTBFASMPJPD15SMP JP 061215 CC 158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00
11
12RTFDBGSMPJPD15SMP JP 061215 CC 157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
13RTFDBGSMPJPD15SMP JP 061215 CC 160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
14RTFDBGSMPJPD15SMP JP 061215 CC 160457INT INT 31/12/201031/12/20100.00
15
16
SMPJPD15


Excel Workbook
ABCDEFGHI
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContract DateSettlementDateTrans Units
6RTEYFGSMPUB915SMP UBS 092015 CC 150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
7RTEYFGSMPUB915SMP UBS 092015 CC 151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
8RTEYFGSMPUB915SMP UBS 092015 CC 152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00
9
10RTFDBGSMPUB915SMP UBS 092015 CC 154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
11RTFDBGSMPUB915SMP UBS 092015 CC 155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
12RTFDBGSMPUB915SMP UBS 092015 CC 158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
13RTFDBGSMPUB915SMP UBS 092015 CC 159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00
14
15RSTBFASMPUB915SMP UBS 092015 CC 160460INT INT 31/12/201031/12/20100.00
16RSTBFASMPUB915SMP UBS 092015 CC 160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00
17
18
19
SMPUB915
 
Sort by date Sort by votes
Hiker, how do you add paste values to the below.
Also as per #1 i dont require columns D:E

.SpecialCells(12).Copy Worksheets(WSary(a)).Range("A" & NR)

hiker95 said:
Isabella,


Sample raw data:


Excel Workbook
ABCDEFGHIJK
4PfCodeSecurity* * * * * Short NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCode*ContractDate*SettlementDate* * * *TransUnits
5RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
6RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00
7RSTBFASMPJPD15SMP JP 061215 CC * *85DS04157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
8RSTBFASMPJPD15SMP JP 061215 CC * *85DS04158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00
9RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
10RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
11RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160457INT *INT *31/12/201031/12/20100.00
12RTEYFGSMPUB915SMP UBS 092015 CC *85DS04150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
13RTEYFGSMPUB915SMP UBS 092015 CC *85DS04151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
14RTEYFGSMPUB915SMP UBS 092015 CC *85DS04152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00
15RTFDBGSMPUB915SMP UBS 092015 CC *85DS04154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
16RTFDBGSMPUB915SMP UBS 092015 CC *85DS04155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
17RTFDBGSMPUB915SMP UBS 092015 CC *85DS04158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
18RTFDBGSMPUB915SMP UBS 092015 CC *85DS04159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00
19RSTBFASMPUB915SMP UBS 092015 CC *85DS04160460INT *INT *31/12/201031/12/20100.00
20RSTBFASMPUB915SMP UBS 092015 CC *85DS04160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00
21
RawData





Excel Workbook
ABCDEFGHIJK
5PfCodeSecurity* * * * * Short NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCode*ContractDate*SettlementDate* * * *TransUnits
6
7
8
9
10
11
12
13
SMPJPD15





Excel Workbook
ABCDEFGHIJK
5PfCodeSecurity* * * * * Short NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCode*ContractDate*SettlementDate* * * *TransUnits
6
7
8
9
10
11
12
13
14
15
SMPUB915





After the macro:


Excel Workbook
ABCDEFGHIJK
5PfCodeSecurity* * * * * Short NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCode*ContractDate*SettlementDate* * * *TransUnits
6RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
7RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00
8RSTBFASMPJPD15SMP JP 061215 CC * *85DS04157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
9RSTBFASMPJPD15SMP JP 061215 CC * *85DS04158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00
10RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
11RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
12RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160457INT *INT *31/12/201031/12/20100.00
13
SMPJPD15





Excel Workbook
ABCDEFGHIJK
5PfCodeSecurity* * * * * Short NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCode*ContractDate*SettlementDate* * * *TransUnits
6RTEYFGSMPUB915SMP UBS 092015 CC *85DS04150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
7RTEYFGSMPUB915SMP UBS 092015 CC *85DS04151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
8RTEYFGSMPUB915SMP UBS 092015 CC *85DS04152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00
9RTFDBGSMPUB915SMP UBS 092015 CC *85DS04154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
10RTFDBGSMPUB915SMP UBS 092015 CC *85DS04155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
11RTFDBGSMPUB915SMP UBS 092015 CC *85DS04158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
12RTFDBGSMPUB915SMP UBS 092015 CC *85DS04159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00
13RSTBFASMPUB915SMP UBS 092015 CC *85DS04160460INT *INT *31/12/201031/12/20100.00
14RSTBFASMPUB915SMP UBS 092015 CC *85DS04160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00
15
SMPUB915





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.


Code: 
Option Explicit
Sub DistributeRows()
' hiker95, 03/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=533700
Dim w1 As Worksheet
Dim LR As Long, a As Long, NR As Long, WSary
Application.ScreenUpdating = False
WSary = Array("SMPJPD15", "SMPUB915")
With Worksheets("RawData")
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  .AutoFilterMode = False
  With .Range("A4:K" & LR)
    For a = LBound(WSary) To UBound(WSary)
      .AutoFilter Field:=2, Criteria1:=WSary(a)
      NR = Worksheets(WSary(a)).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      On Error Resume Next
      .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Copy Worksheets(WSary(a)).Range("A" & NR)
      On Error GoTo 0
      .AutoFilter
    Next a
  End With
End With
Application.ScreenUpdating = True
End Sub
Then run the DistributeRows macro.
Click to expand...
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Isabella,

FYI: When you reply to a post, you do not have to add the quote from the helpers reply.


Sample worksheet before the macro:


Excel Workbook
ABCDEFGHIJK
4PfCodeSecurityShort NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnits
5RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
6RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00
7RSTBFASMPJPD15SMP JP 061215 CC * *85DS04157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
8RSTBFASMPJPD15SMP JP 061215 CC * *85DS04158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00
9RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
10RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
11RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160457INT *INT *31/12/201031/12/20100.00
12RTEYFGSMPUB915SMP UBS 092015 CC *85DS04150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
13RTEYFGSMPUB915SMP UBS 092015 CC *85DS04151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
14RTEYFGSMPUB915SMP UBS 092015 CC *85DS04152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00
15RTFDBGSMPUB915SMP UBS 092015 CC *85DS04154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
16RTFDBGSMPUB915SMP UBS 092015 CC *85DS04155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
17RTFDBGSMPUB915SMP UBS 092015 CC *85DS04158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
18RTFDBGSMPUB915SMP UBS 092015 CC *85DS04159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00
19RSTBFASMPUB915SMP UBS 092015 CC *85DS04160460INT *INT *31/12/201031/12/20100.00
20RSTBFASMPUB915SMP UBS 092015 CC *85DS04160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00
21
RawData





Excel Workbook
ABCDEFGHI
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnits
6
7
8
9
10
11
12
13
14
15
SMPJPD15





Excel Workbook
ABCDEFGHI
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnits
6
7
8
9
10
11
12
13
14
15
16
17
SMPUB915





After the macro:


Excel Workbook
ABCDEFGHI
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnits
6RSTAHYSMPJPD15SMP JP 061215 CC * *157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
7RSTAHYSMPJPD15SMP JP 061215 CC * *158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00
8
9RSTBFASMPJPD15SMP JP 061215 CC * *157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
10RSTBFASMPJPD15SMP JP 061215 CC * *158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00
11
12RTFDBGSMPJPD15SMP JP 061215 CC * *157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
13RTFDBGSMPJPD15SMP JP 061215 CC * *160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
14RTFDBGSMPJPD15SMP JP 061215 CC * *160457INT *INT *31/12/201031/12/20100.00
15
SMPJPD15





Excel Workbook
ABCDEFGHI
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnits
6RTEYFGSMPUB915SMP UBS 092015 CC *150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
7RTEYFGSMPUB915SMP UBS 092015 CC *151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
8RTEYFGSMPUB915SMP UBS 092015 CC *152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00
9
10RTFDBGSMPUB915SMP UBS 092015 CC *154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
11RTFDBGSMPUB915SMP UBS 092015 CC *155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
12RTFDBGSMPUB915SMP UBS 092015 CC *158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
13RTFDBGSMPUB915SMP UBS 092015 CC *159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00
14
15RSTBFASMPUB915SMP UBS 092015 CC *160460INT *INT *31/12/201031/12/20100.00
16RSTBFASMPUB915SMP UBS 092015 CC *160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00
17
SMPUB915





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.


Code: 
Option Explicit
Sub DistributeRowsV2()
' hiker95, 03/06/2011
' http://www.mrexcel.com/forum/showthread.php?t=533700
Dim w1 As Worksheet
Dim LR As Long, LR2 As Long, a As Long, aa As Long, NR As Long, WSary
Application.ScreenUpdating = False
WSary = Array("SMPJPD15", "SMPUB915")
With Worksheets("RawData")
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  .AutoFilterMode = False
  With .Range("A4:K" & LR)
    For a = LBound(WSary) To UBound(WSary)
      .AutoFilter Field:=2, Criteria1:=WSary(a)
      NR = Worksheets(WSary(a)).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      On Error Resume Next
      .Columns("A:C").Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Copy Worksheets(WSary(a)).Range("A" & NR)
      .Columns("F:K").Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Copy Worksheets(WSary(a)).Range("D" & NR)
      On Error GoTo 0
      LR2 = Worksheets(WSary(a)).Cells(Rows.Count, 1).End(xlUp).Row
      For aa = LR2 To 7 Step -1
        If Worksheets(WSary(a)).Cells(aa, 1) <> Worksheets(WSary(a)).Cells(aa - 1, 1) Then
          Worksheets(WSary(a)).Rows(aa).Insert
        End If
      Next aa
      .AutoFilter
    Next a
  End With
End With
Application.ScreenUpdating = True
End Sub


Then run the DistributeRowsV2 macro.
 
Upvote 0
Hi Hiker,

You missed out the paste special, if i have formatting the code will override it.
 
Upvote 0
Isabella,

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).


Code: 
Option Explicit
Sub DistributeRowsV3()
' hiker95, 03/06/2011
' http://www.mrexcel.com/forum/showthread.php?t=533700
Dim w1 As Worksheet
Dim LR As Long, LR2 As Long, a As Long, aa As Long, NR As Long, WSary
Application.ScreenUpdating = False
WSary = Array("SMPJPD15", "SMPUB915")
With Worksheets("RawData")
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  .AutoFilterMode = False
  With .Range("A4:K" & LR)
    For a = LBound(WSary) To UBound(WSary)
      .AutoFilter Field:=2, Criteria1:=WSary(a)
      NR = Worksheets(WSary(a)).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      On Error Resume Next
      .Columns("A:C").Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Copy
      Worksheets(WSary(a)).Range("A" & NR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      .Columns("F:K").Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Copy
      Worksheets(WSary(a)).Range("D" & NR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      On Error GoTo 0
      LR2 = Worksheets(WSary(a)).Cells(Rows.Count, 1).End(xlUp).Row
      For aa = LR2 To 7 Step -1
        If Worksheets(WSary(a)).Cells(aa, 1) <> Worksheets(WSary(a)).Cells(aa - 1, 1) Then
          Worksheets(WSary(a)).Rows(aa).Insert
        End If
      Next aa
      .AutoFilter
    Next a
  End With
End With
Application.ScreenUpdating = True
End Sub


Then run the DistributeRowsV3 macro.
 
Upvote 0
Hiker thanks for this, it works great. Just one last thing is there a way the code can add formula in Col M & N as shown in the below example, so for every last row of each unique portfolio have a formula in Col M and N which will show the difference, in Col J-L i will input manual figures.

Excel Workbook
ABCDEFGHIJKLMN
4PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
5RSTAHYSMPJPD15SMP JP 061215 CC * *157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
6RSTAHYSMPJPD15SMP JP 061215 CC * *158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00440,000.000.00
7
8RSTBFASMPJPD15SMP JP 061215 CC * *157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
9RSTBFASMPJPD15SMP JP 061215 CC * *158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00480,000.000.00
10
11RTFDBGSMPJPD15SMP JP 061215 CC * *157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
12RTFDBGSMPJPD15SMP JP 061215 CC * *160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
13RTFDBGSMPJPD15SMP JP 061215 CC * *160457INT *INT *31/12/201031/12/201000.000.00
14
15RTEYFGSMPUB915SMP UBS 092015 CC *150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
16RTEYFGSMPUB915SMP UBS 092015 CC *151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
17RTEYFGSMPUB915SMP UBS 092015 CC *152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00520,000.000.00
18
19RTFDBGSMPUB915SMP UBS 092015 CC *154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
20RTFDBGSMPUB915SMP UBS 092015 CC *155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
21RTFDBGSMPUB915SMP UBS 092015 CC *158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
22RTFDBGSMPUB915SMP UBS 092015 CC *159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00520,000.000.00
23
24RSTBFASMPUB915SMP UBS 092015 CC *160460INT *INT *31/12/201031/12/20100
25RSTBFASMPUB915SMP UBS 092015 CC *160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00320,000.000.00
Sheet1
 
Upvote 0
Isabella,


Is there anything in worksheet RawData in range A1:A3?



Excel Workbook
A
1
2
3
4PfCode
RawData
 
Upvote 0
Isabella,


Sample worksheets before the macro:


Excel Workbook
ABCDEFGHIJK
4PfCodeSecurityShort NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnits
5RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
6RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00
7RSTBFASMPJPD15SMP JP 061215 CC * *85DS04157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
8RSTBFASMPJPD15SMP JP 061215 CC * *85DS04158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00
9RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
10RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
11RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160457INT *INT *31/12/201031/12/20100.00
12RTEYFGSMPUB915SMP UBS 092015 CC *85DS04150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
13RTEYFGSMPUB915SMP UBS 092015 CC *85DS04151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
14RTEYFGSMPUB915SMP UBS 092015 CC *85DS04152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00
15RTFDBGSMPUB915SMP UBS 092015 CC *85DS04154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
16RTFDBGSMPUB915SMP UBS 092015 CC *85DS04155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
17RTFDBGSMPUB915SMP UBS 092015 CC *85DS04158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
18RTFDBGSMPUB915SMP UBS 092015 CC *85DS04159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00
19RSTBFASMPUB915SMP UBS 092015 CC *85DS04160460INT *INT *31/12/201031/12/20100.00
20RSTBFASMPUB915SMP UBS 092015 CC *85DS04160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00
21
RawData





Excel Workbook
ABCDEFGHIJKLMN
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
6
SMPJPD15





Excel Workbook
ABCDEFGHIJKLMN
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
6
SMPUB915





After the new macro:


Excel Workbook
ABCDEFGHIJKLMN
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
6RSTAHYSMPJPD15SMP JP 061215 CC * *157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
7RSTAHYSMPJPD15SMP JP 061215 CC * *158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00440,000.000.00
8
9RSTBFASMPJPD15SMP JP 061215 CC * *157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
10RSTBFASMPJPD15SMP JP 061215 CC * *158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00480,000.000.00
11
12RTFDBGSMPJPD15SMP JP 061215 CC * *157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
13RTFDBGSMPJPD15SMP JP 061215 CC * *160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
14RTFDBGSMPJPD15SMP JP 061215 CC * *160457INT *INT *31/12/201031/12/201000.000.00
15
SMPJPD15





Excel Workbook
ABCDEFGHIJKLMN
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
6RTEYFGSMPUB915SMP UBS 092015 CC *150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
7RTEYFGSMPUB915SMP UBS 092015 CC *151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
8RTEYFGSMPUB915SMP UBS 092015 CC *152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00520,000.000.00
9
10RTFDBGSMPUB915SMP UBS 092015 CC *154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
11RTFDBGSMPUB915SMP UBS 092015 CC *155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
12RTFDBGSMPUB915SMP UBS 092015 CC *158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
13RTFDBGSMPUB915SMP UBS 092015 CC *159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00520,000.000.00
14
15RSTBFASMPUB915SMP UBS 092015 CC *160460INT *INT *31/12/201031/12/20100
16RSTBFASMPUB915SMP UBS 092015 CC *160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00320,000.000.00
17
SMPUB915





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).


Code: 
Option Explicit
Sub DistributeRowsV4()
' hiker95, 03/07/2011
' http://www.mrexcel.com/forum/showthread.php?t=533700
Dim LR As Long, LR2 As Long, a As Long, aa As Long, NR As Long, WSary
Dim MArea As Range, SR As Long, ER As Long, RC As Long
Application.ScreenUpdating = False
WSary = Array("SMPJPD15", "SMPUB915")
Worksheets("RawData").Range("A1:A3").ClearContents
With Worksheets("RawData")
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  .AutoFilterMode = False
  With .Range("A4:K" & LR)
    For a = LBound(WSary) To UBound(WSary)
      .AutoFilter Field:=2, Criteria1:=WSary(a)
      NR = Worksheets(WSary(a)).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      On Error Resume Next
      RC = 0
      RC = Application.Subtotal(103, Worksheets("RawData").Range("A4:A" & LR)) - 1
      If RC > 1 Then
        Worksheets(WSary(a)).Range("A" & NR).Resize(RC, 3).Value = .Columns("A:C").Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Value
        Worksheets(WSary(a)).Range("D" & NR).Resize(RC, 6).Value = .Columns("F:K").Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Value
      End If
      On Error GoTo 0
      LR2 = Worksheets(WSary(a)).Cells(Rows.Count, 1).End(xlUp).Row
      For aa = LR2 To 7 Step -1
        If Worksheets(WSary(a)).Cells(aa, 1) <> Worksheets(WSary(a)).Cells(aa - 1, 1) Then
          Worksheets(WSary(a)).Rows(aa).Insert
        End If
      Next aa
      .AutoFilter
      For Each MArea In Worksheets(WSary(a)).Range("I6", Worksheets(WSary(a)).Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
        With MArea
          SR = .Row
          ER = SR + .Rows.Count - 1
          Worksheets(WSary(a)).Range("M" & ER).Formula = "=K" & ER & "-I" & ER & ""
          Worksheets(WSary(a)).Range("N" & ER).Formula = "=L" & ER & "-J" & ER & ""
          Worksheets(WSary(a)).Range("M" & ER & ":N" & ER).NumberFormat = "#,##0.00"
        End With
      Next MArea
    Next a
  End With
End With
Application.ScreenUpdating = True
End Sub


Then run the DistributeRowsV4 macro.
 
Upvote 0
Thanks Hiker. I'm going to be adding formatting to each of the worksheets so how do i incorporate the below with your code?

"A6:M" & "Q:R" hairline inside bordering

.Borders.LineStyle = xlNone
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 0
.Borders.Weight = xlHairline


and N6:P & "S:S" would be

.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Interior.ColorIndex = 24
.Borders.ColorIndex = 2

hiker95 said:
Isabella,


Sample worksheets before the macro:


Excel Workbook
ABCDEFGHIJK
4PfCodeSecurityShort NameReportGroupCategory&SubtypeIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnits
5RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
6RSTAHYSMPJPD15SMP JP 061215 CC * *85DS04158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00
7RSTBFASMPJPD15SMP JP 061215 CC * *85DS04157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
8RSTBFASMPJPD15SMP JP 061215 CC * *85DS04158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00
9RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
10RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
11RTFDBGSMPJPD15SMP JP 061215 CC * *85DS04160457INT *INT *31/12/201031/12/20100.00
12RTEYFGSMPUB915SMP UBS 092015 CC *85DS04150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
13RTEYFGSMPUB915SMP UBS 092015 CC *85DS04151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
14RTEYFGSMPUB915SMP UBS 092015 CC *85DS04152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00
15RTFDBGSMPUB915SMP UBS 092015 CC *85DS04154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
16RTFDBGSMPUB915SMP UBS 092015 CC *85DS04155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
17RTFDBGSMPUB915SMP UBS 092015 CC *85DS04158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
18RTFDBGSMPUB915SMP UBS 092015 CC *85DS04159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00
19RSTBFASMPUB915SMP UBS 092015 CC *85DS04160460INT *INT *31/12/201031/12/20100.00
20RSTBFASMPUB915SMP UBS 092015 CC *85DS04160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00
21
RawData





Excel Workbook
ABCDEFGHIJKLMN
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
6
SMPJPD15





Excel Workbook
ABCDEFGHIJKLMN
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
6
SMPUB915





After the new macro:


Excel Workbook
ABCDEFGHIJKLMN
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
6RSTAHYSMPJPD15SMP JP 061215 CC * *157957DS-PURJPMAUD22/12/201022/12/2010-3,500,000.00
7RSTAHYSMPJPD15SMP JP 061215 CC * *158305DS-PURJPMAUD23/12/201023/12/2010-440,000.00440,000.000.00
8
9RSTBFASMPJPD15SMP JP 061215 CC * *157959DS-PURJPMAUD22/12/201022/12/2010-3,150,000.00
10RSTBFASMPJPD15SMP JP 061215 CC * *158304DS-PURJPMAUD23/12/201023/12/2010-480,000.00480,000.000.00
11
12RTFDBGSMPJPD15SMP JP 061215 CC * *157958DS-PURJPMAUD22/12/201022/12/2010-770,000.00
13RTFDBGSMPJPD15SMP JP 061215 CC * *160168DS-PURJPMSYD30/12/201030/12/2010-280,000.00
14RTFDBGSMPJPD15SMP JP 061215 CC * *160457INT *INT *31/12/201031/12/201000.000.00
15
SMPJPD15





Excel Workbook
ABCDEFGHIJKLMN
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsDifference UnitDifference Interest
6RTEYFGSMPUB915SMP UBS 092015 CC *150708DS-PURUBSAUD3/12/20103/12/2010-380,000.00
7RTEYFGSMPUB915SMP UBS 092015 CC *151121DS-PURUBSAUD6/12/20106/12/2010-440,000.00
8RTEYFGSMPUB915SMP UBS 092015 CC *152649DS-PURUBSAUD8/12/20108/12/2010-520,000.00520,000.000.00
9
10RTFDBGSMPUB915SMP UBS 092015 CC *154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00
11RTFDBGSMPUB915SMP UBS 092015 CC *155882DS-PURUBSAUD16/12/201016/12/2010-570,000.00
12RTFDBGSMPUB915SMP UBS 092015 CC *158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00
13RTFDBGSMPUB915SMP UBS 092015 CC *159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00520,000.000.00
14
15RSTBFASMPUB915SMP UBS 092015 CC *160460INT *INT *31/12/201031/12/20100
16RSTBFASMPUB915SMP UBS 092015 CC *160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00320,000.000.00
17
SMPUB915





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).


Code: 
Option Explicit
Sub DistributeRowsV4()
' hiker95, 03/07/2011
' http://www.mrexcel.com/forum/showthread.php?t=533700
Dim LR As Long, LR2 As Long, a As Long, aa As Long, NR As Long, WSary
Dim MArea As Range, SR As Long, ER As Long, RC As Long
Application.ScreenUpdating = False
WSary = Array("SMPJPD15", "SMPUB915")
Worksheets("RawData").Range("A1:A3").ClearContents
With Worksheets("RawData")
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  .AutoFilterMode = False
  With .Range("A4:K" & LR)
    For a = LBound(WSary) To UBound(WSary)
      .AutoFilter Field:=2, Criteria1:=WSary(a)
      NR = Worksheets(WSary(a)).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      On Error Resume Next
      RC = 0
      RC = Application.Subtotal(103, Worksheets("RawData").Range("A4:A" & LR)) - 1
      If RC > 1 Then
        Worksheets(WSary(a)).Range("A" & NR).Resize(RC, 3).Value = .Columns("A:C").Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Value
        Worksheets(WSary(a)).Range("D" & NR).Resize(RC, 6).Value = .Columns("F:K").Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Value
      End If
      On Error GoTo 0
      LR2 = Worksheets(WSary(a)).Cells(Rows.Count, 1).End(xlUp).Row
      For aa = LR2 To 7 Step -1
        If Worksheets(WSary(a)).Cells(aa, 1) <> Worksheets(WSary(a)).Cells(aa - 1, 1) Then
          Worksheets(WSary(a)).Rows(aa).Insert
        End If
      Next aa
      .AutoFilter
      For Each MArea In Worksheets(WSary(a)).Range("I6", Worksheets(WSary(a)).Range("I" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
        With MArea
          SR = .Row
          ER = SR + .Rows.Count - 1
          Worksheets(WSary(a)).Range("M" & ER).Formula = "=K" & ER & "-I" & ER & ""
          Worksheets(WSary(a)).Range("N" & ER).Formula = "=L" & ER & "-J" & ER & ""
          Worksheets(WSary(a)).Range("M" & ER & ":N" & ER).NumberFormat = "#,##0.00"
        End With
      Next MArea
    Next a
  End With
End With
Application.ScreenUpdating = True
End Sub
Then run the DistributeRowsV4 macro.
Click to expand...
 
Upvote 0
Isabella,

Im going to be adding formatting to each of the worksheets so how do i incorporate the below with your code?
Click to expand...


"A6:M" & "Q:R" hairline inside bordering

.Borders.LineStyle = xlNone
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = 0
.Borders.Weight = xlHairline


and N6:P & "S:S" would be

.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
.Interior.ColorIndex = 24
.Borders.ColorIndex = 2


Per your last and final request: Please supply a screenshot of worksheet SMPJPD15 containing all formulae and the above formatting for one group of data.
 
Upvote 0
Hiker here is an example, dont worry about the ranges as i can play with those in your code, but this is the format i require, for the non format part i want inside hairline border as per the small code i provided, you can use the code i provided as that has all the settings.

Excel Workbook
ABCDEFGHIJKLMNOP
5PfCodeSecurityShort NameIDNumberTransShortNameBrokerCodeContractDateSettlementDateTransUnitsInterestYield %UnitsInterestDifference UnitDifference InterestComments
6RTEYFGSMPUB915SMP UBS 092015 CC *150708DS-PURUBSAUD3/12/20103/12/2010-380,000.001,951.00
7RTEYFGSMPUB915SMP UBS 092015 CC *151121DS-PURUBSAUD6/12/20106/12/2010-440,000.003,216.00
8RTEYFGSMPUB915SMP UBS 092015 CC *152649DS-PURUBSAUD8/12/20108/12/2010-520,000.006,549.00520,000.00-6,549.00
9
10RTFDBGSMPUB915SMP UBS 092015 CC *154816DS-PURUBSAUD14/12/201014/12/2010-260,000.00456.36
11RTFDBGSMPUB915SMP UBS 092015 CC *155882DS-PURUBSAUD16/12/201016/12/2010-570,000.004,569.12
12RTFDBGSMPUB915SMP UBS 092015 CC *158291DS-PURUBSAUD23/12/201023/12/2010-490,000.00519.45
13RTFDBGSMPUB915SMP UBS 092015 CC *159263DS-PURUBSAUD29/12/201029/12/2010-520,000.00854.36520,000.00-854.36
14
15RSTBFASMPUB915SMP UBS 092015 CC *160460INT *INT *31/12/201031/12/20100321
16RSTBFASMPUB915SMP UBS 092015 CC *160656DS-PURUBSAUD31/12/201031/12/2010-320,000.00123.00320,000.00-123.00
17
SMPUB915
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
How to Insert another loop for inputting multiple receiver name in an Email based on criteria
Replies
3
Views
468
portews
P
M
  • Question
Need to add _AfterUpdate events to a dynamically-created class
Replies
1
Views
883
Matrovsky
M
F
  • Question
First time coding, want help optimizing a long macro
Replies
0
Views
902
fcats
F
S
  • Question
VBA Code help
Replies
2
Views
964
skmcrodgers
S
V
  • Question
VBA to pull emails from outlook
Replies
1
Views
4K
Macropod
Macropod

Forum statistics

Threads
1,214,426
Messages
6,119,411
Members
448,894
Latest member
spenstar

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