How to Simplify this Time Consuming Tax Via Macro

daveyc18

Active Member
Joined
Feb 11, 2013
Messages
410
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

Active Member
Joined
Feb 11, 2013
Messages
410
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
42,703
Office Version
365
Platform
Windows
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
 

daveyc18

Active Member
Joined
Feb 11, 2013
Messages
410
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.
 

Forum statistics

Threads
1,085,726
Messages
5,385,471
Members
401,954
Latest member
phil3elkins

Some videos you may like

This Week's Hot Topics

Top