How to Simplify this Time Consuming Tax Via Macro

[daveyc18]

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.

 

[daveyc18]

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 ?

 

[Peter_SSs]

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.

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

 

[daveyc18]

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.

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.

 

[daveyc18]

apoligies, i will try the code now.

i get application defined error at

" .Range("A12:n12").Resize(x).Value = Rep"

 

[Peter_SSs]

i get application defined error at

" .Range("A12:n12").Resize(x).Value = Rep"

That line does not appear in my code.