How to Simplify this Time Consuming Tax Via Macro

daveyc18

Well-known Member
Joined
Feb 11, 2013
Messages
782
Office Version
  1. 365
  2. 2010
Here's the link to a sample spreadsheet I made:

https://drive.google.com/open?id=1cQJvncI9xsAsrTicUA4Ql-MnZI2pwW_d


Essentially, I want the macro to go to the "Final" tab

-filter for each unique security ID
-insert a new sheet and name it that security ID
-and copy and paste that info into the that new sheet, but the information to be copied and pasted is separated by "repo" and "reverse"
-HOWEVER, if the "Cpty Type" is "CDCC", essentially do the same thing, but when making a new sheet, name it "CDCC - XXXX," where "XXXX" represents the security ID

I have already completed the task manually to give you guys a better understanding on what I want the macro to do.

Note that the actual data has more than 80 unique security IDs, so this would be very time consuming to do manually.
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Here's the link to a sample spreadsheet I made:

https://drive.google.com/open?id=1cQJvncI9xsAsrTicUA4Ql-MnZI2pwW_d


Essentially, I want the macro to go to the "Final" tab

-filter for each unique security ID
-insert a new sheet and name it that security ID
-and copy and paste that info into the that new sheet, but the information to be copied and pasted is separated by "repo" and "reverse"
-HOWEVER, if the "Cpty Type" is "CDCC", essentially do the same thing, but when making a new sheet, name it "CDCC - XXXX," where "XXXX" represents the security ID

I have already completed the task manually to give you guys a better understanding on what I want the macro to do.

Note that the actual data has more than 80 unique security IDs, so this would be very time consuming to do manually.

anybody please ?
 
Upvote 0
anybody please ?
Many of the helpers here choose not to download files from other sites or, due to security restrictions at work sites, are unable to download such files.
You will get many more potential helpers (& faster) if you explain your problem clearly in words and, if needed, post a small (copyable) screen shot or two directly in your post. My signature block below has help regarding that.

In relation to your question, try this in a copy of your workbook.

Rich (BB code):
Sub Split_Final_Data()
  Dim a As Variant, Rep As Variant, Rev As Variant, Hdrs As Variant
  Dim i As Long, x As Long, y As Long, fr As Long
  Dim currSec As Variant
  Dim sName As String
  
  With Sheets("Final")
    Hdrs = .Range("A2:D2").Value
    a = .Range("A3", .Range("A" & .Rows.Count).End(xlUp).Offset(1)).Resize(, 4).Value
  End With
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Do
    i = i + 1
    If a(i, 1) <> currSec Then
      If i > 1 Then
        sName = IIf(a(i - 1, 4) = "CDCC", "CCDC - ", "") & currSec
        On Error Resume Next
        Sheets(CStr(currSec)).Delete
        On Error GoTo 0
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = sName
        With Sheets(sName)
          .Range("A10").Value = "Repo"
          .Range("A11:D11").Value = Hdrs
          .Range("A12:D12").Resize(x).Value = Rep
          .Range("B" & .Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=SUM(R12C:R[-1]C)"
          fr = .Range("B" & .Rows.Count).End(xlUp).Row + 4
          .Range("A" & fr - 2).Value = "Reverse"
          .Range("A" & fr - 1).Resize(, 4).Value = Hdrs
          .Range("A" & fr).Resize(y, 4).Value = Rev
          .Range("B" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=SUM(R" & fr & "C:R[-1]C)"
        End With
      End If
      currSec = a(i, 1)
      ReDim Rep(1 To UBound(a) - i + 1, 1 To 4)
      ReDim Rev(1 To UBound(a) - i + 1, 1 To 4)
      x = 0: y = 0
    End If
    Select Case LCase(a(i, 3))
      Case "repo"
        x = x + 1
        Rep(x, 1) = currSec
        Rep(x, 2) = a(i, 2)
        Rep(x, 3) = "Repo"
        Rep(x, 4) = a(i, 4)
      Case "reverse"
        y = y + 1
        Rev(y, 1) = currSec
        Rev(y, 2) = a(i, 2)
        Rev(y, 3) = "Reverse"
        Rev(y, 4) = a(i, 4)
    End Select
  Loop Until i = UBound(a)
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
 
Upvote 0
Many of the helpers here choose not to download files from other sites or, due to security restrictions at work sites, are unable to download such files.
You will get many more potential helpers (& faster) if you explain your problem clearly in words and, if needed, post a small (copyable) screen shot or two directly in your post. My signature block below has help regarding that.

In relation to your question, try this in a copy of your workbook.

Rich (BB code):
Sub Split_Final_Data()
  Dim a As Variant, Rep As Variant, Rev As Variant, Hdrs As Variant
  Dim i As Long, x As Long, y As Long, fr As Long
  Dim currSec As Variant
  Dim sName As String
  
  With Sheets("Final")
    Hdrs = .Range("A2:D2").Value
    a = .Range("A3", .Range("A" & .Rows.Count).End(xlUp).Offset(1)).Resize(, 4).Value
  End With
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Do
    i = i + 1
    If a(i, 1) <> currSec Then
      If i > 1 Then
        sName = IIf(a(i - 1, 4) = "CDCC", "CCDC - ", "") & currSec
        On Error Resume Next
        Sheets(CStr(currSec)).Delete
        On Error GoTo 0
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = sName
        With Sheets(sName)
          .Range("A10").Value = "Repo"
          .Range("A11:D11").Value = Hdrs
          .Range("A12:D12").Resize(x).Value = Rep
          .Range("B" & .Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=SUM(R12C:R[-1]C)"
          fr = .Range("B" & .Rows.Count).End(xlUp).Row + 4
          .Range("A" & fr - 2).Value = "Reverse"
          .Range("A" & fr - 1).Resize(, 4).Value = Hdrs
          .Range("A" & fr).Resize(y, 4).Value = Rev
          .Range("B" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=SUM(R" & fr & "C:R[-1]C)"
        End With
      End If
      currSec = a(i, 1)
      ReDim Rep(1 To UBound(a) - i + 1, 1 To 4)
      ReDim Rev(1 To UBound(a) - i + 1, 1 To 4)
      x = 0: y = 0
    End If
    Select Case LCase(a(i, 3))
      Case "repo"
        x = x + 1
        Rep(x, 1) = currSec
        Rep(x, 2) = a(i, 2)
        Rep(x, 3) = "Repo"
        Rep(x, 4) = a(i, 4)
      Case "reverse"
        y = y + 1
        Rev(y, 1) = currSec
        Rev(y, 2) = a(i, 2)
        Rev(y, 3) = "Reverse"
        Rev(y, 4) = a(i, 4)
    End Select
  Loop Until i = UBound(a)
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

apoligies, i will try the code now.
 
Upvote 0

Forum statistics

Threads
1,224,884
Messages
6,181,571
Members
453,054
Latest member
arz007

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