Remove unwanted section of code without error

The code for this Excel file has a section called "Remove weekly and quarterly spreads based on the format of the exp column" as shown in this screenshot and in the code pasted below. It is no longer necessary to remove those rows, but simply removing the section of code causes issues.

I need assistance  in successfully removing that section of code such that the macro will still run properly on either pm or rm tab.

Please don't re-post the file if you can keep from it but rather, just the new code. Assistance is greatly appreciated.
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output.'

'The table data contained in Output is based on the Trade History section of the original tab.'
'It is important to note that the legs (rows) of each spread are numbered and remain in the same order'
'just as they appear in the original tab. The spreads are then numbered as well and moved into'
'individually numbered positions'. When the end user filters the sheet, these positions (which can'
'contain multiple spreads) remain together, and the numbered columns representing the Spread numbers'
'and Position numbers are intended to be hidden for greater readability.'

'Future development will include hiding the Leg and Spread numbers, as well as making some
'calculations on each overall position.'

Const AOH = "Account Order History"
Const ATH = "Account Trade History"
Const PAL = "Profits and Losses"
Const EQT = "Equities"
Dim wsopt As Worksheet
    
Sub TradeReport()
    Dim wsPM As Worksheet
    Dim aCell As Range, bCell As Range, cCell As Range, delRange As Range
    Dim AOHRow As Long, PALRow As Long, ATHRow As Long
    Dim LastRow As Long, i As Long, j As Long
    Dim shName As String
    Dim SearchString As String, MatchString As String, init1String As String, init2String As String
    Dim intNum  As Long
    
    On Error GoTo Whoa
    
    Application.ScreenUpdating = False
    
    Set wsPM = ActiveSheet
    
    shName = wsPM.Name
        
    '--> Make New "Output" Sheet if one already exists'
    On Error Resume Next
    Application.DisplayAlerts = False
    Set wsopt = Sheets("Output")
    intNum = 0
    While Err.Number = 0
        Err.Clear
        intNum = intNum + 1
        Set wsopt = Sheets("Output" & intNum)
    Wend
    Err.Clear
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    '--> Recreate "Output" Sheet and move it to the right'
    Set wsopt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    If intNum = 0 Then
        wsopt.Name = "Output"
    Else
        wsopt.Name = "Output" & intNum
    End If
    
    '--> Find the "Account Trade History" cell in Sheet PM'
    Set aCell = wsPM.Columns(1).Find(What:=ATH, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    '--> If "Account Trade History" is found'
    If Not aCell Is Nothing Then
        '--> Get the starting row of "Account Trade History"'
        ATHRow = aCell.Row
        
        '--> Find the "Profits and Losses" cell in Sheet PM'
        Set bCell = wsPM.Columns(1).Find(What:=PAL, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If shName = "rm" Then
            '--> Find the "Equities" cell in Sheet RM'
            Set bCell = wsPM.Columns(1).Find(What:=EQT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        End If
        
        
        '--> If "Profits and Losses" is found'
        If Not bCell Is Nothing Then
            '--> Get the starting row of "Profits and Losses"
            PALRow = bCell.Row
            
            '--> Output Trade History to new tab.'
            wsPM.Rows((ATHRow + 1) & ":" & (PALRow - 1)).Copy wsopt.Rows(1)
            
            If shName = "rm" Then
                wsopt.Select
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
            End If
            
            With wsopt
                '--> Remove last three columns because they are duplicates.'
                .Columns("M:O").Delete Shift:=xlToLeft
                
                '--> Define the notes column.'
                .Range("A1").Value = "Notes"
                .Columns("A:A").Replace What:="DEFAULT", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
                '--> Get the last row of Output Sheet'
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                
                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1
                    
                '--> Copy the notes into the new notes column.'
                    For i = AOHRow To ATHRow
                        SearchString = wsPM.Range("D" & i).Value & "###" & _
                        wsPM.Range("F" & i).Value & "###" & _
                        wsPM.Range("G" & i).Value & "###" & _
                        wsPM.Range("H" & i).Value & "###" & _
                        wsPM.Range("I" & i).Value
                
                        init1String = wsPM.Range("F" & i).Value
                
                        For j = 2 To LastRow
                            init2String = wsopt.Range("F" & j).Value
                
                            If init1String = init2String Then
                                MatchString = .Range("D" & j).Value & "###" & _
                                              .Range("F" & j).Value & "###" & _
                                              .Range("G" & j).Value & "###" & _
                                              .Range("H" & j).Value & "###" & _
                                              .Range("I" & j).Value
                
                                If MatchString = SearchString Then
                                    .Range("A" & j).Value = wsPM.Range("A" & i).Value
                                End If
                            End If
                        Next j
                    Next i
                End If
                
                '--> Make the Output tab into a table that can be filtered by the column headers.'
                .ListObjects.Add(xlSrcRange, Range("$A$1:$L$" & LastRow), , xlYes).Name = "Table1"
                .ListObjects("Table1").ShowTableStyleRowStripes = False
                'ListObjects("Table1").TableStyle = "TableStyleLight1"'
                .Columns("B:L").EntireColumn.AutoFit
                
            End With
        End If
    End If
    Application.ScreenUpdating = False
    NewUpdates
    Indexing
    Sorting
    Application.ScreenUpdating = True
    
'--> Clean Up and Exit.'
LetsContinue:
    Application.ScreenUpdating = True
    Set aCell = Nothing: Set bCell = Nothing: Set cCell = Nothing: Set delRange = Nothing
    On Error Resume Next
    Set wsopt = Nothing: Set wsPM = Nothing
    On Error GoTo 0
    Exit Sub
    
'--> Error Handling'
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub
Private Sub NewUpdates()
Dim i As Integer

'---> Create extra space at the top of the table of approximately 10 rows.
wsopt.Rows("1:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'---> Modify the date format of the Exec Time column to reflect the format of ddd mmm dd, yyyy hh:mm'
'and the Exp column to reflect the format of mm-yy.'
For i = 12 To wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row
wsopt.Range("B" & i).NumberFormat = "ddd mmm-dd-yyyy hh:mm"
wsopt.Range("G" & i).NumberFormat = "mmm-yy"
Next i

'--> Add Columns for Postion, Spread, and Leg Numbers'
'Add P# column before the Exec Time column with the comment "Position #" in the header for the P# column.'
'Add  S# column between the Exec Time and Spread columns with the comment "Spread #" in the header for the S# column.'
'Add L# column between the Spread and Side columns with the comment "Leg #" in the header for the L# column.'
wsopt.Columns("B:B").Insert Shift:=xlToRight
wsopt.Columns("D:D").Insert Shift:=xlToRight
wsopt.Columns("F:F").Insert Shift:=xlToRight

'---> Format column D and E to number format
wsopt.Range("D12:D" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"
wsopt.Range("F12:F" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"
wsopt.Range("B12:B" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"

'---> Rename the header of the added Position, Spread, and Leg Number columns'
wsopt.Range("B11") = "P#": wsopt.Range("D11") = "S#": wsopt.Range("F11") = "L#"

'---> Set autofit to the width of column D and E
wsopt.Columns("D:D").EntireColumn.AutoFit
wsopt.Columns("F:F").EntireColumn.AutoFit
wsopt.Columns("B:B").EntireColumn.AutoFit
'---> Add comments
wsopt.Range("B11").AddComment
wsopt.Range("B11").Comment.Visible = False
wsopt.Range("B11").Comment.Text Text:="Position No"
wsopt.Range("D11").AddComment
wsopt.Range("D11").Comment.Visible = False
wsopt.Range("D11").Comment.Text Text:="Spread No"
wsopt.Range("F11").AddComment
wsopt.Range("F11").Comment.Visible = False
wsopt.Range("F11").Comment.Text Text:="Leg No"

'---> Shrink the printout so all column will be printed in the same page
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 0
Application.PrintCommunication = True

End Sub

Private Sub Indexing()

'--> Indexing macro - The Spread No should be a unique number per Spread (some spreads have multiple
'legs) with the lower numbers on the newest spreads and the highest numbers on the oldest spreads.'
'The legs of each spread should be numbered according to how many rows the Spread has starting'
'with the number 1 and should start over at number 1 again on the next spread. Note that each Spread'
'can have several Legs and Each Position can contain several Spreads. A Spread is part of the same'
'Position if any of it's Legs (rows) contain the same Symbol, Exp, Strike, and Type of any other'
'Spread in the sheet.'


Dim i As Integer, k As Double, z As Double, j As Double, l As Double, test As Boolean, test1 As Boolean
Dim ws As Worksheet, q As Double, Rcount As Double, x As Double, SpreadNo As Double
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = Sheets(Sheets.Count)
k = 0: z = -1: Rcount = wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row: SpreadNo = 0

For i = 12 To Rcount

    If k = 0 And z = -1 Then
        k = k + 1: z = z + 2:
        ws.Cells(k, z) = wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i) & " " & wsopt.Range("K" & i)
        For x = i + 1 To Rcount
        If wsopt.Range("C" & x) = "" Then
            If InStr(1, ws.Cells(k, z), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, z) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
        Else
        Exit For
        End If
        Next x
        ws.Cells(k + 1, z) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
        ws.Cells(k + 1, z + 1) = ws.Cells(k, z + 1) + 1
        wsopt.Range("B" & i) = 1:  wsopt.Range("F" & i) = 1
    Else
        If j = 0 Then j = 1
        If wsopt.Range("C" & i) = "" Then
            test = True
        Else
        test = False: q = -1
    For j = 1 To z Step 2
        q = q + 1
        If InStr(1, ws.Cells(1, j), wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i)) > 0 Then
        If InStr(1, ws.Cells(1, j), wsopt.Range("K" & i)) > 0 Then
            wsopt.Range("B" & i) = j - q: test = True
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, j) = ws.Cells(k, j) & " " & wsopt.Range("K" & x)
            Else
            Exit For
            End If
            Next x
        Else
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) > 0 Then wsopt.Range("B" & i) = j - q: test = True
            Else
            Exit For
            End If
            Next x
            If test = True Then
            ws.Cells(k, j) = ws.Cells(k, j) & " " & wsopt.Range("K" & i)
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, j) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
            Else
            Exit For
            End If
            Next x
            End If
        End If
        
        
        If test = True Then Exit For
        End If
        Next j
        End If
    
    If test = True Then
             l = ws.Cells(ws.Rows.Count, j).End(xlUp).Row + 1
        If wsopt.Range("C" & i) = "" Then
            If j = 0 Then wsopt.Range("B" & i) = 1 Else wsopt.Range("B" & i) = j - q
            ws.Cells(l - 1, j + 1) = ws.Cells(l - 1, j + 1) + 1
            wsopt.Range("F" & i) = ws.Cells(l - 1, j + 1)
        Else
            ws.Cells(l, j) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
            ws.Cells(l, j + 1) = ws.Cells(l, j + 1) + 1
            wsopt.Range("F" & i) = 1
        End If
    Else
        k = 1: z = z + 2: q = q + 1
        ws.Cells(k, z) = wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i) & " " & wsopt.Range("K" & i)
        For x = i + 1 To Rcount
        If wsopt.Range("C" & x) = "" Then
            If InStr(1, ws.Cells(k, z), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, z) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
        Else
        Exit For
        End If
        Next x
        ws.Cells(k + 1, z) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
        ws.Cells(k + 1, z + 1) = ws.Cells(k, z + 1) + 1
        wsopt.Range("B" & i) = z - q: wsopt.Range("F" & i) = 1
    End If
    End If
Next i
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True

'---> The empty cells in the Exec Time and Spread columns should take on the information'
'of the preceding cell because they are part of the same Spread.'

For i = 12 To Rcount
    If wsopt.Range("E" & i) = "" And i > 12 Then
    wsopt.Range("E" & i) = wsopt.Range("E" & i - 1)
    wsopt.Range("C" & i) = wsopt.Range("C" & i - 1)
    wsopt.Range("C" & i & ":E" & i).Font.Color = -5395027
    End If
Next i

wsopt.Sort.SortFields.Add Key:=Range("C11"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        
         With ActiveSheet.Sort
        .SetRange Range("A12:O" & Rcount)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For i = 12 To Rcount
     If wsopt.Range("F" & i) = 1 Then
        SpreadNo = SpreadNo + 1: wsopt.Range("D" & i) = SpreadNo
     Else
     wsopt.Range("D" & i) = SpreadNo
     End If
Next i
 
End Sub

Private Sub Sorting()

'--> This Sort macro is preceeded by the above Indexing macro and should sort by the entire position'
'using the date and time of the last Spreads within that position. It is important that each Leg (row)'
'of each Spread stay in order, and each Spread within the Position stay in order.' The most recent'
'Spread will be at the bottom of each Position and the most recent Position, based on the newest
'spread within it, will be listed above other Positions.'

Dim i As Double, Brow As Double, Erow As Double, Prow As Double
Dim Rcount As Double


On Error Resume Next
 Rcount = wsopt.Cells(wsopt.Rows.Count, "B").End(xlUp).Row
 '---> Sorting the output by the Position No.
    wsopt.Sort.SortFields.Clear
    wsopt.Sort.SortFields.Add Key:=Range("B11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     
    
    With wsopt.Sort
        .SetRange Range("A11:O" & Rcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'--> Skipping a row between each major position
For i = Rcount To 13 Step -1
If Range("B" & i) <> Range("B" & i - 1) And Range("B" & i) <> "" Then
wsopt.Rows(i & Chr(58) & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i

'---> Sorting the output by Date descending
 Brow = 0
For i = 12 To Rcount
If wsopt.Range("B" & i) <> "" Then
    If Brow = 0 Then
        Brow = i: Erow = i
        Else
        Erow = i
    End If
Else
    wsopt.Sort.SortFields.Add Key:=Range("C11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
         With wsopt.Sort
        .SetRange Range("A" & Brow & ":O" & Erow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Brow = 0
wsopt.Range("A" & i - 1 & ":O" & i - 1).Copy Destination:=wsopt.Range("A" & i & ":O" & i)
wsopt.Range("A" & i & ":O" & i).Font.ThemeColor = xlThemeColorDark1
End If
Next i
wsopt.Range("P" & 12) = wsopt.Range("D" & 12): Prow = wsopt.Range("D" & 12)
For i = 13 To Rcount
If wsopt.Range("B" & i) = wsopt.Range("B" & i - 1) Then
    wsopt.Range("P" & i) = Prow
Else
    Prow = wsopt.Range("D" & i)
    wsopt.Range("P" & i) = Prow
End If
Next i
wsopt.Sort.SortFields.Clear
wsopt.Sort.SortFields.Add Key:=Range("P11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     
    
    With wsopt.Sort
        .SetRange Range("A11:P" & Rcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
wsopt.Range("B" & 12) = 1: Prow = 1
For i = 13 To Rcount
If wsopt.Range("P" & i) = wsopt.Range("P" & i - 1) Then
    wsopt.Range("B" & i) = Prow
    If wsopt.Range("P" & i) = wsopt.Range("P" & i + 1) Then wsopt.Range("B" & i).Font.Color = -5395027
Else
    Prow = Prow + 1
    wsopt.Range("B" & i) = Prow
End If
Next i
wsopt.Columns("P:P").Delete Shift:=xlToLeft
   
End Sub

Open in new window

rtod2Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

gowflowCommented:
Well I don't know if this is what your looking for but you need to do the following:
1) Make a copy of your exisiting file and give it a new name
2) Goto VBA and delete both sub TradeReport and Sub NewUpdates (if you don't know how just when you goto VBA doubleclik in the left pane on module1 then in the right pane you will be displayed the code. click on the bottom left icon to view 1 sub at a time. In the top right combobox click and choose Sub TradeReport and delete the whole code then choose Sub NewUpdates and delete the whole code) then Click on the below code and choose SELECT ALL the right click choose COPY and paste it in module1 after any end sub.
3) Save the file and exit
4) restart the file and try it.

Let me know
gowflow
Sub TradeReport()
    Dim wsPM As Worksheet
    Dim aCell As Range, bCell As Range, cCell As Range, delRange As Range
    Dim AOHRow As Long, PALRow As Long, ATHRow As Long
    Dim LastRow As Long, i As Long, j As Long
    Dim shName As String
    Dim SearchString As String, MatchString As String, init1String As String, init2String As String
    Dim intNum  As Long
    
    On Error GoTo Whoa
    
    Application.ScreenUpdating = False
    
    Set wsPM = ActiveSheet
    
    shName = wsPM.Name
        
    '--> Make New "Output" Sheet if one already exists'
    On Error Resume Next
    Application.DisplayAlerts = False
    Set wsopt = Sheets("Output")
    intNum = 0
    While Err.Number = 0
        Err.Clear
        intNum = intNum + 1
        Set wsopt = Sheets("Output" & intNum)
    Wend
    Err.Clear
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    '--> Recreate "Output" Sheet and move it to the right'
    Set wsopt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    If intNum = 0 Then
        wsopt.Name = "Output"
    Else
        wsopt.Name = "Output" & intNum
    End If
    
    '--> Find the "Account Trade History" cell in Sheet PM'
    Set aCell = wsPM.Columns(1).Find(What:=ATH, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    '--> If "Account Trade History" is found'
    If Not aCell Is Nothing Then
        '--> Get the starting row of "Account Trade History"'
        ATHRow = aCell.Row
        
        '--> Find the "Profits and Losses" cell in Sheet PM'
        Set bCell = wsPM.Columns(1).Find(What:=PAL, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If shName = "rm" Then
            '--> Find the "Equities" cell in Sheet RM'
            Set bCell = wsPM.Columns(1).Find(What:=EQT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        End If
        
        
        '--> If "Profits and Losses" is found'
        If Not bCell Is Nothing Then
            '--> Get the starting row of "Profits and Losses"
            PALRow = bCell.Row
            
            '--> Output Trade History to new tab.'
            wsPM.Rows((ATHRow + 1) & ":" & (PALRow - 1)).Copy wsopt.Rows(1)
            
            If shName = "rm" Then
                wsopt.Select
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
            End If
            
            With wsopt
                '--> Remove last three columns because they are duplicates.'
                .Columns("M:O").Delete Shift:=xlToLeft
                
                '--> Define the notes column.'
                .Range("A1").Value = "Notes"
                .Columns("A:A").Replace What:="DEFAULT", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
                '--> Get the last row of Output Sheet'
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                
                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                'If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1
                    
                '--> Copy the notes into the new notes column.'
                    For i = AOHRow To ATHRow
                        SearchString = wsPM.Range("D" & i).Value & "###" & _
                        wsPM.Range("F" & i).Value & "###" & _
                        wsPM.Range("G" & i).Value & "###" & _
                        wsPM.Range("H" & i).Value & "###" & _
                        wsPM.Range("I" & i).Value
                
                        init1String = wsPM.Range("F" & i).Value
                
                        For j = 2 To LastRow
                            init2String = wsopt.Range("F" & j).Value
                
                            If init1String = init2String Then
                                MatchString = .Range("D" & j).Value & "###" & _
                                              .Range("F" & j).Value & "###" & _
                                              .Range("G" & j).Value & "###" & _
                                              .Range("H" & j).Value & "###" & _
                                              .Range("I" & j).Value
                
                                If MatchString = SearchString Then
                                    .Range("A" & j).Value = wsPM.Range("A" & i).Value
                                End If
                            End If
                        Next j
                    Next i
                End If
                
                '--> Make the Output tab into a table that can be filtered by the column headers.'
                .ListObjects.Add(xlSrcRange, Range("$A$1:$L$" & LastRow), , xlYes).Name = "Table1"
                .ListObjects("Table1").ShowTableStyleRowStripes = False
                'ListObjects("Table1").TableStyle = "TableStyleLight1"'
                .Columns("B:L").EntireColumn.AutoFit
                
            End With
        End If
    End If
    Application.ScreenUpdating = False
    NewUpdates
    Indexing
    Sorting
    Application.ScreenUpdating = True
    
'--> Clean Up and Exit.'
LetsContinue:
    Application.ScreenUpdating = True
    Set aCell = Nothing: Set bCell = Nothing: Set cCell = Nothing: Set delRange = Nothing
    On Error Resume Next
    Set wsopt = Nothing: Set wsPM = Nothing
    On Error GoTo 0
    Exit Sub
    
'--> Error Handling'
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub


Private Sub NewUpdates()
Dim i As Integer

'---> Create extra space at the top of the table of approximately 10 rows.
wsopt.Rows("1:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'---> Modify the date format of the Exec Time column to reflect the format of ddd mmm dd, yyyy hh:mm'
'and the Exp column to reflect the format of mm-yy.'
For i = 12 To wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row
wsopt.Range("B" & i).NumberFormat = "ddd mmm-dd-yyyy hh:mm"
wsopt.Range("G" & i).NumberFormat = "mmm-yy"
Next i

'--> Add Columns for Postion, Spread, and Leg Numbers'
'Add P# column before the Exec Time column with the comment "Position #" in the header for the P# column.'
'Add  S# column between the Exec Time and Spread columns with the comment "Spread #" in the header for the S# column.'
'Add L# column between the Spread and Side columns with the comment "Leg #" in the header for the L# column.'
wsopt.Columns("B:B").Insert Shift:=xlToRight
wsopt.Columns("D:D").Insert Shift:=xlToRight
wsopt.Columns("F:F").Insert Shift:=xlToRight

'---> Format column D and E to number format
wsopt.Range("D12:D" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"
wsopt.Range("F12:F" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"
wsopt.Range("B12:B" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"

'---> Rename the header of the added Position, Spread, and Leg Number columns'
wsopt.Range("B11") = "P#": wsopt.Range("D11") = "S#": wsopt.Range("F11") = "L#"

'---> Set autofit to the width of column D and E
wsopt.Columns("D:D").EntireColumn.AutoFit
wsopt.Columns("F:F").EntireColumn.AutoFit
wsopt.Columns("B:B").EntireColumn.AutoFit
'---> Add comments
wsopt.Range("B11").AddComment
wsopt.Range("B11").Comment.Visible = False
wsopt.Range("B11").Comment.Text Text:="Position No"
wsopt.Range("D11").AddComment
wsopt.Range("D11").Comment.Visible = False
wsopt.Range("D11").Comment.Text Text:="Spread No"
wsopt.Range("F11").AddComment
wsopt.Range("F11").Comment.Visible = False
wsopt.Range("F11").Comment.Text Text:="Leg No"

'---> Shrink the printout so all column will be printed in the same page
'Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
'Application.PrintCommunication = False
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
'Application.PrintCommunication = True

End Sub

Open in new window

0
rtod2Author Commented:
Will do.  Can you point out what you changed and why?

From:

To:

etc?
0
rtod2Author Commented:
I see now.
I did a comparison here http://www.tareeinternet.com/scripts/comparison-tool/, and attached is a screenshot of the results.  It looks like you want to remove my indexing section which I need in order to fulfill the overall purpose of the macro.
comparison-results.png
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

dlmilleCommented:
@rtod2 - slick tool :)
0
gowflowCommented:
I only commented out the line
If Not delRange Is Nothing Then delRange.Delete
in Sub TradeReport as you did not want the lines to be removed.

and also got an error at line
Application.PrintCommunication = True
whcih is a property that does not exist and I also commented out this line in Sub NewUpdates

Sorry did not know you needed the code that was modified.

At the end did it give you the result you expected ??
gowflow
0
rtod2Author Commented:
Goflow, Thank you for chiming in on this but it isn't what I was asking for regardless of what it does to one column.  I can't have other functions of the code removed.  What I DID want removed was the section in question which is designed to remove rows based on the formatting of a single column because it is no longer necessary to do that. If the section I reference is needed because it does more than what I thought it did, then it would be ok to leave it, but I need to clearly understand what you removed and why you didn't remove what I was wanting removed. The remaining function of the code of 'course should remain. Please advise with revised code if possible.
0
gowflowCommented:
well I thought you wanted to stop removing the rows which you indidcated in the snapshot in the beginning of the question. and the instruction
If Not delRange Is Nothing Then delRange.Delete

the delRange.Delete
means that for all that was accumulated in the Range "delRange" delete the appropriate rows so by stoppping this instruction I stoped deleting the rows like you asked !!!

The other issue I commented out because it is giving an error here just remove the single quote in front of the instruction
Application.PrintCommunication = True
You have 3 like this at the bottom of the sub NewUpdates.

So is it doing what you want ?? I thought I gave you what you wanted if not please explain as I need to understand what the code is doing
gowflow
0
rtod2Author Commented:
I needed to remove that whole section without getting an error
0
gowflowCommented:
Well here it is. But please understand that by removing only the previous line it is as if you removed the whole section. But nevertheless in this new code I commented out the whole section.
Replace this Sub TradeReport and replace it by the below code.
Let me know
Sub TradeReport()
    Dim wsPM As Worksheet
    Dim aCell As Range, bCell As Range, cCell As Range, delRange As Range
    Dim AOHRow As Long, PALRow As Long, ATHRow As Long
    Dim LastRow As Long, i As Long, j As Long
    Dim shName As String
    Dim SearchString As String, MatchString As String, init1String As String, init2String As String
    Dim intNum  As Long
    
    On Error GoTo Whoa
    
    Application.ScreenUpdating = False
    
    Set wsPM = ActiveSheet
    
    shName = wsPM.Name
        
    '--> Make New "Output" Sheet if one already exists'
    On Error Resume Next
    Application.DisplayAlerts = False
    Set wsopt = Sheets("Output")
    intNum = 0
    While Err.Number = 0
        Err.Clear
        intNum = intNum + 1
        Set wsopt = Sheets("Output" & intNum)
    Wend
    Err.Clear
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    '--> Recreate "Output" Sheet and move it to the right'
    Set wsopt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    If intNum = 0 Then
        wsopt.Name = "Output"
    Else
        wsopt.Name = "Output" & intNum
    End If
    
    '--> Find the "Account Trade History" cell in Sheet PM'
    Set aCell = wsPM.Columns(1).Find(What:=ATH, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    '--> If "Account Trade History" is found'
    If Not aCell Is Nothing Then
        '--> Get the starting row of "Account Trade History"'
        ATHRow = aCell.Row
        
        '--> Find the "Profits and Losses" cell in Sheet PM'
        Set bCell = wsPM.Columns(1).Find(What:=PAL, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If shName = "rm" Then
            '--> Find the "Equities" cell in Sheet RM'
            Set bCell = wsPM.Columns(1).Find(What:=EQT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        End If
        
        
        '--> If "Profits and Losses" is found'
        If Not bCell Is Nothing Then
            '--> Get the starting row of "Profits and Losses"
            PALRow = bCell.Row
            
            '--> Output Trade History to new tab.'
            wsPM.Rows((ATHRow + 1) & ":" & (PALRow - 1)).Copy wsopt.Rows(1)
            
            If shName = "rm" Then
                wsopt.Select
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
            End If
            
            With wsopt
                '--> Remove last three columns because they are duplicates.'
                .Columns("M:O").Delete Shift:=xlToLeft
                
                '--> Define the notes column.'
                .Range("A1").Value = "Notes"
                .Columns("A:A").Replace What:="DEFAULT", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
                '--> Get the last row of Output Sheet'
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                
                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                'For i = 2 To LastRow
                '    If Not IsDate(.Range("G" & i).Value) Then
                '        If delRange Is Nothing Then
                '            Set delRange = .Rows(i)
                '        Else
                '            Set delRange = Union(delRange, .Rows(i))
                '        End If
                '        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                '            Set delRange = Union(delRange, .Rows(i + 1))
                '        End If
                '    End If
                'Next i
            
                'If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1
                    
                '--> Copy the notes into the new notes column.'
                    For i = AOHRow To ATHRow
                        SearchString = wsPM.Range("D" & i).Value & "###" & _
                        wsPM.Range("F" & i).Value & "###" & _
                        wsPM.Range("G" & i).Value & "###" & _
                        wsPM.Range("H" & i).Value & "###" & _
                        wsPM.Range("I" & i).Value
                
                        init1String = wsPM.Range("F" & i).Value
                
                        For j = 2 To LastRow
                            init2String = wsopt.Range("F" & j).Value
                
                            If init1String = init2String Then
                                MatchString = .Range("D" & j).Value & "###" & _
                                              .Range("F" & j).Value & "###" & _
                                              .Range("G" & j).Value & "###" & _
                                              .Range("H" & j).Value & "###" & _
                                              .Range("I" & j).Value
                
                                If MatchString = SearchString Then
                                    .Range("A" & j).Value = wsPM.Range("A" & i).Value
                                End If
                            End If
                        Next j
                    Next i
                End If
                
                '--> Make the Output tab into a table that can be filtered by the column headers.'
                .ListObjects.Add(xlSrcRange, Range("$A$1:$L$" & LastRow), , xlYes).Name = "Table1"
                .ListObjects("Table1").ShowTableStyleRowStripes = False
                'ListObjects("Table1").TableStyle = "TableStyleLight1"'
                .Columns("B:L").EntireColumn.AutoFit
                
            End With
        End If
    End If
    Application.ScreenUpdating = False
    NewUpdates
    Indexing
    Sorting
    Application.ScreenUpdating = True
    
'--> Clean Up and Exit.'
LetsContinue:
    Application.ScreenUpdating = True
    Set aCell = Nothing: Set bCell = Nothing: Set cCell = Nothing: Set delRange = Nothing
    On Error Resume Next
    Set wsopt = Nothing: Set wsPM = Nothing
    On Error GoTo 0
    Exit Sub
    
'--> Error Handling'
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Open in new window

0
rtod2Author Commented:
Gowflow,
Thank you.  That's much better but I wanted to understand why I can't remove the whole section?
                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1

Open in new window

.
Your suggestion would leave the following behind.
LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1

Open in new window

0
gowflowCommented:
Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

because this section is looking for constant AOH that is defined to be: "Account Order History"
and it is related to the next section:
'--> Copy the notes into the new notes column.'
and has nothing to do with the previous removing of rows.

Every new section starts with the
LastRow = .. statement and not with the heading of the said section !!!

Hope clearer for you. Still you did not answer me did it do the job ??
gowflow
0
rtod2Author Commented:
It did not do the job. What it does is mess up other data.

Running the macro without changing anything produces the correct output but without some of the rows copied.
Running the macro with your changes adds in the additional rows but messes up some other things.
0
gowflowCommented:
Running the macro without changing anything produces the correct output but without some of the rows copied.
>>> Can you explain a bit more about "without some of the rows copied." So I can assist more in finding where is the trouble maybe you wrongly indicated the section I removed. Again I stress that I did not review the whole code as this would take sometime if you cannot assist in explaining the above sentence then maybe I will need to go thru the code line by line to understand it fully then I could help you but this will take sometime.
gowflow
0
rtod2Author Commented:
All I can tell you is that the output from running the code without your changes is dramatically different on many levels. The only rows the code removes are those containing poorly formatted data in the Exp column. Due to the way the macro is written, the elimination of those rows is no longer needed. Running code with your changes "should have" virtually no effect except that you will notice some strange values, but only in the Exp column and nowhere else. Your changes currently affect a whole host of things that aren't supposed to change.
0
dlmilleCommented:
Maybe a stupid question, but do you get the results you want if you just just comment out line 124?  If the answer is yes,  then it can be optimized from there.
0
dlmilleCommented:
>>just comment out line 124
I was referring to the original post.
0
gowflowCommented:
Well I went in the details of the code and seems by commenting out my initial line
If Not delRange Is Nothing Then delRange.Delete

If you are positioned on the sheet RM and activate the macro it seems that the results are ok and the problem relies in sheet PM (which you did not clearly specified)

I looked into the code and followed the logic to trap RM data so concluded that for PM you need to set the end of data to be Options as this was not existing I created a new Constant called OPT = "Options" and in case of sheet PM had to look for this occurence in Col A to trap end of data.

The attached file has the new code for you to try.

In case you need to replace your production file here it is:

1) Make a new copy of you present workbook under a new name.
2) goto VBA and add this in the decalration section
Const OPT = "Options"
3) delete the code for Sub TradeReport and replace it by the below code

 
Sub TradeReport()
    Dim wsPM As Worksheet
    Dim aCell As Range, bCell As Range, cCell As Range, delRange As Range
    Dim AOHRow As Long, PALRow As Long, ATHRow As Long
    Dim LastRow As Long, i As Long, j As Long
    Dim shName As String
    Dim SearchString As String, MatchString As String, init1String As String, init2String As String
    Dim intNum  As Long
    
    On Error GoTo Whoa
    
    Application.ScreenUpdating = False
    
    Set wsPM = ActiveSheet
    
    shName = wsPM.Name
        
    '--> Make New "Output" Sheet if one already exists'
    On Error Resume Next
    Application.DisplayAlerts = False
    Set wsopt = Sheets("Output")
    intNum = 0
    While Err.Number = 0
        Err.Clear
        intNum = intNum + 1
        Set wsopt = Sheets("Output" & intNum)
    Wend
    Err.Clear
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    '--> Recreate "Output" Sheet and move it to the right'
    Set wsopt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    If intNum = 0 Then
        wsopt.Name = "Output"
    Else
        wsopt.Name = "Output" & intNum
    End If
    
    '--> Find the "Account Trade History" cell in Sheet PM'
    Set aCell = wsPM.Columns(1).Find(What:=ATH, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    '--> If "Account Trade History" is found'
    If Not aCell Is Nothing Then
        '--> Get the starting row of "Account Trade History"'
        ATHRow = aCell.Row
        
        '--> Find the "Profits and Losses" cell in Sheet PM'
        Set bCell = wsPM.Columns(1).Find(What:=PAL, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If shName = "rm" Then
            '--> Find the "Equities" cell in Sheet RM'
            Set bCell = wsPM.Columns(1).Find(What:=EQT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        Else
            '--> Find the "Options" cell in Sheet PM'
            Set bCell = wsPM.Columns(1).Find(What:=OPT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        End If
        
        
        '--> If "Profits and Losses" is found'
        If Not bCell Is Nothing Then
            '--> Get the starting row of "Profits and Losses"
            PALRow = bCell.Row
            
            '--> Output Trade History to new tab.'
            wsPM.Rows((ATHRow + 1) & ":" & (PALRow - 1)).Copy wsopt.Rows(1)
            
            If shName = "rm" Then
                wsopt.Select
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
            End If
            
            With wsopt
                '--> Remove last three columns because they are duplicates.'
                .Columns("M:O").Delete Shift:=xlToLeft
                
                '--> Define the notes column.'
                .Range("A1").Value = "Notes"
                .Columns("A:A").Replace What:="DEFAULT", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
                '--> Get the last row of Output Sheet'
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                
                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                'If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1
                    
                '--> Copy the notes into the new notes column.'
                    For i = AOHRow To ATHRow
                        SearchString = wsPM.Range("D" & i).Value & "###" & _
                        wsPM.Range("F" & i).Value & "###" & _
                        wsPM.Range("G" & i).Value & "###" & _
                        wsPM.Range("H" & i).Value & "###" & _
                        wsPM.Range("I" & i).Value
                
                        init1String = wsPM.Range("F" & i).Value
                
                        For j = 2 To LastRow
                            init2String = wsopt.Range("F" & j).Value
                
                            If init1String = init2String Then
                                MatchString = .Range("D" & j).Value & "###" & _
                                              .Range("F" & j).Value & "###" & _
                                              .Range("G" & j).Value & "###" & _
                                              .Range("H" & j).Value & "###" & _
                                              .Range("I" & j).Value
                
                                If MatchString = SearchString Then
                                    .Range("A" & j).Value = wsPM.Range("A" & i).Value
                                End If
                            End If
                        Next j
                    Next i
                End If
                
                '--> Make the Output tab into a table that can be filtered by the column headers.'
                .ListObjects.Add(xlSrcRange, Range("$A$1:$L$" & LastRow), , xlYes).Name = "Table1"
                .ListObjects("Table1").ShowTableStyleRowStripes = False
                'ListObjects("Table1").TableStyle = "TableStyleLight1"'
                .Columns("B:L").EntireColumn.AutoFit
                
            End With
        End If
    End If
    Application.ScreenUpdating = False
    NewUpdates
    Indexing
    Sorting
    Application.ScreenUpdating = True
    
'--> Clean Up and Exit.'
LetsContinue:
    Application.ScreenUpdating = True
    Set aCell = Nothing: Set bCell = Nothing: Set cCell = Nothing: Set delRange = Nothing
    On Error Resume Next
    Set wsopt = Nothing: Set wsPM = Nothing
    On Error GoTo 0
    Exit Sub
    
'--> Error Handling'
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Open in new window


4) SAVE and exit.
5) start the workbook and try it when positioned in RM and the in PM.

Let me know
gowflow
test---new.xlsm
0
rtod2Author Commented:
Goflow,
Please try not to post the actual file. Thank you for doing that. The error I got is here >> http://screencast.com/t/j9f2kxUy3S and my new code complete is pasted below.  Looks like we are almost home. Thank you for your help.
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output.'

'The table data contained in Output is based on the Trade History section of the original tab.'
'It is important to note that the legs (rows) of each spread are numbered and remain in the same order'
'just as they appear in the original tab. The spreads are then numbered as well and moved into'
'individually numbered positions'. When the end user filters the sheet, these positions (which can'
'contain multiple spreads) remain together, and the numbered columns representing the Spread numbers'
'and Position numbers are intended to be hidden for greater readability.'

'Future development will include hiding the Leg and Spread numbers, as well as making some
'calculations on each overall position.'

Const AOH = "Account Order History"
Const ATH = "Account Trade History"
Const PAL = "Profits and Losses"
Const EQT = "Equities"
Const OPT = "Options"
Dim wsopt As Worksheet
    
Sub TradeReport()
    Dim wsPM As Worksheet
    Dim aCell As Range, bCell As Range, cCell As Range, delRange As Range
    Dim AOHRow As Long, PALRow As Long, ATHRow As Long
    Dim LastRow As Long, i As Long, j As Long
    Dim shName As String
    Dim SearchString As String, MatchString As String, init1String As String, init2String As String
    Dim intNum  As Long
    
    On Error GoTo Whoa
    
    Application.ScreenUpdating = False
    
    Set wsPM = ActiveSheet
    
    shName = wsPM.Name
        
    '--> Make New "Output" Sheet if one already exists'
    On Error Resume Next
    Application.DisplayAlerts = False
    Set wsopt = Sheets("Output")
    intNum = 0
    While Err.Number = 0
        Err.Clear
        intNum = intNum + 1
        Set wsopt = Sheets("Output" & intNum)
    Wend
    Err.Clear
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    '--> Recreate "Output" Sheet and move it to the right'
    Set wsopt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    If intNum = 0 Then
        wsopt.Name = "Output"
    Else
        wsopt.Name = "Output" & intNum
    End If
    
    '--> Find the "Account Trade History" cell in Sheet PM'
    Set aCell = wsPM.Columns(1).Find(What:=ATH, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    '--> If "Account Trade History" is found'
    If Not aCell Is Nothing Then
        '--> Get the starting row of "Account Trade History"'
        ATHRow = aCell.Row
        
        '--> Find the "Profits and Losses" cell in Sheet PM'
        Set bCell = wsPM.Columns(1).Find(What:=PAL, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If shName = "rm" Then
            '--> Find the "Equities" cell in Sheet RM'
            Set bCell = wsPM.Columns(1).Find(What:=EQT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        Else
            '--> Find the "Options" cell in Sheet PM'
            Set bCell = wsPM.Columns(1).Find(What:=OPT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        End If
        
        
        '--> If "Profits and Losses" is found'
        If Not bCell Is Nothing Then
            '--> Get the starting row of "Profits and Losses"
            PALRow = bCell.Row
            
            '--> Output Trade History to new tab.'
            wsPM.Rows((ATHRow + 1) & ":" & (PALRow - 1)).Copy wsopt.Rows(1)
            
            If shName = "rm" Then
                wsopt.Select
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
            End If
            
            With wsopt
                '--> Remove last three columns because they are duplicates.'
                .Columns("M:O").Delete Shift:=xlToLeft
                
                '--> Define the notes column.'
                .Range("A1").Value = "Notes"
                .Columns("A:A").Replace What:="DEFAULT", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
                '--> Get the last row of Output Sheet'
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                
                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                'If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1
                    
                '--> Copy the notes into the new notes column.'
                    For i = AOHRow To ATHRow
                        SearchString = wsPM.Range("D" & i).Value & "###" & _
                        wsPM.Range("F" & i).Value & "###" & _
                        wsPM.Range("G" & i).Value & "###" & _
                        wsPM.Range("H" & i).Value & "###" & _
                        wsPM.Range("I" & i).Value
                
                        init1String = wsPM.Range("F" & i).Value
                
                        For j = 2 To LastRow
                            init2String = wsopt.Range("F" & j).Value
                
                            If init1String = init2String Then
                                MatchString = .Range("D" & j).Value & "###" & _
                                              .Range("F" & j).Value & "###" & _
                                              .Range("G" & j).Value & "###" & _
                                              .Range("H" & j).Value & "###" & _
                                              .Range("I" & j).Value
                
                                If MatchString = SearchString Then
                                    .Range("A" & j).Value = wsPM.Range("A" & i).Value
                                End If
                            End If
                        Next j
                    Next i
                End If
                
                '--> Make the Output tab into a table that can be filtered by the column headers.'
                .ListObjects.Add(xlSrcRange, Range("$A$1:$L$" & LastRow), , xlYes).Name = "Table1"
                .ListObjects("Table1").ShowTableStyleRowStripes = False
                'ListObjects("Table1").TableStyle = "TableStyleLight1"'
                .Columns("B:L").EntireColumn.AutoFit
                
            End With
        End If
    End If
    Application.ScreenUpdating = False
    NewUpdates
    Indexing
    Sorting
    Application.ScreenUpdating = True
    
'--> Clean Up and Exit.'
LetsContinue:
    Application.ScreenUpdating = True
    Set aCell = Nothing: Set bCell = Nothing: Set cCell = Nothing: Set delRange = Nothing
    On Error Resume Next
    Set wsopt = Nothing: Set wsPM = Nothing
    On Error GoTo 0
    Exit Sub
    
'--> Error Handling'
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Private Sub Indexing()

'--> Indexing macro - The Spread No should be a unique number per Spread (some spreads have multiple
'legs) with the lower numbers on the newest spreads and the highest numbers on the oldest spreads.'
'The legs of each spread should be numbered according to how many rows the Spread has starting'
'with the number 1 and should start over at number 1 again on the next spread. Note that each Spread'
'can have several Legs and Each Position can contain several Spreads. A Spread is part of the same'
'Position if any of it's Legs (rows) contain the same Symbol, Exp, Strike, and Type of any other'
'Spread in the sheet.'


Dim i As Integer, k As Double, z As Double, j As Double, l As Double, test As Boolean, test1 As Boolean
Dim ws As Worksheet, q As Double, Rcount As Double, x As Double, SpreadNo As Double
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = Sheets(Sheets.Count)
k = 0: z = -1: Rcount = wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row: SpreadNo = 0

For i = 12 To Rcount

    If k = 0 And z = -1 Then
        k = k + 1: z = z + 2:
        ws.Cells(k, z) = wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i) & " " & wsopt.Range("K" & i)
        For x = i + 1 To Rcount
        If wsopt.Range("C" & x) = "" Then
            If InStr(1, ws.Cells(k, z), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, z) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
        Else
        Exit For
        End If
        Next x
        ws.Cells(k + 1, z) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
        ws.Cells(k + 1, z + 1) = ws.Cells(k, z + 1) + 1
        wsopt.Range("B" & i) = 1:  wsopt.Range("F" & i) = 1
    Else
        If j = 0 Then j = 1
        If wsopt.Range("C" & i) = "" Then
            test = True
        Else
        test = False: q = -1
    For j = 1 To z Step 2
        q = q + 1
        If InStr(1, ws.Cells(1, j), wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i)) > 0 Then
        If InStr(1, ws.Cells(1, j), wsopt.Range("K" & i)) > 0 Then
            wsopt.Range("B" & i) = j - q: test = True
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, j) = ws.Cells(k, j) & " " & wsopt.Range("K" & x)
            Else
            Exit For
            End If
            Next x
        Else
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) > 0 Then wsopt.Range("B" & i) = j - q: test = True
            Else
            Exit For
            End If
            Next x
            If test = True Then
            ws.Cells(k, j) = ws.Cells(k, j) & " " & wsopt.Range("K" & i)
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, j) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
            Else
            Exit For
            End If
            Next x
            End If
        End If
        
        
        If test = True Then Exit For
        End If
        Next j
        End If
    
    If test = True Then
             l = ws.Cells(ws.Rows.Count, j).End(xlUp).Row + 1
        If wsopt.Range("C" & i) = "" Then
            If j = 0 Then wsopt.Range("B" & i) = 1 Else wsopt.Range("B" & i) = j - q
            ws.Cells(l - 1, j + 1) = ws.Cells(l - 1, j + 1) + 1
            wsopt.Range("F" & i) = ws.Cells(l - 1, j + 1)
        Else
            ws.Cells(l, j) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
            ws.Cells(l, j + 1) = ws.Cells(l, j + 1) + 1
            wsopt.Range("F" & i) = 1
        End If
    Else
        k = 1: z = z + 2: q = q + 1
        ws.Cells(k, z) = wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i) & " " & wsopt.Range("K" & i)
        For x = i + 1 To Rcount
        If wsopt.Range("C" & x) = "" Then
            If InStr(1, ws.Cells(k, z), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, z) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
        Else
        Exit For
        End If
        Next x
        ws.Cells(k + 1, z) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
        ws.Cells(k + 1, z + 1) = ws.Cells(k, z + 1) + 1
        wsopt.Range("B" & i) = z - q: wsopt.Range("F" & i) = 1
    End If
    End If
Next i
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True

'---> The empty cells in the Exec Time and Spread columns should take on the information'
'of the preceding cell because they are part of the same Spread.'

For i = 12 To Rcount
    If wsopt.Range("E" & i) = "" And i > 12 Then
    wsopt.Range("E" & i) = wsopt.Range("E" & i - 1)
    wsopt.Range("C" & i) = wsopt.Range("C" & i - 1)
    wsopt.Range("C" & i & ":E" & i).Font.Color = -5395027
    End If
Next i

wsopt.Sort.SortFields.Add Key:=Range("C11"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        
         With ActiveSheet.Sort
        .SetRange Range("A12:O" & Rcount)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For i = 12 To Rcount
     If wsopt.Range("F" & i) = 1 Then
        SpreadNo = SpreadNo + 1: wsopt.Range("D" & i) = SpreadNo
     Else
     wsopt.Range("D" & i) = SpreadNo
     End If
Next i
 
End Sub

Private Sub Sorting()

'--> This Sort macro is preceeded by the above Indexing macro and should sort by the entire position'
'using the date and time of the last Spreads within that position. It is important that each Leg (row)'
'of each Spread stay in order, and each Spread within the Position stay in order.' The most recent'
'Spread will be at the bottom of each Position and the most recent Position, based on the newest
'spread within it, will be listed above other Positions.'

Dim i As Double, Brow As Double, Erow As Double, Prow As Double
Dim Rcount As Double


On Error Resume Next
 Rcount = wsopt.Cells(wsopt.Rows.Count, "B").End(xlUp).Row
 '---> Sorting the output by the Position No.
    wsopt.Sort.SortFields.Clear
    wsopt.Sort.SortFields.Add Key:=Range("B11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     
    
    With wsopt.Sort
        .SetRange Range("A11:O" & Rcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'--> Skipping a row between each major position
For i = Rcount To 13 Step -1
If Range("B" & i) <> Range("B" & i - 1) And Range("B" & i) <> "" Then
wsopt.Rows(i & Chr(58) & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i

'---> Sorting the output by Date descending
 Brow = 0
For i = 12 To Rcount
If wsopt.Range("B" & i) <> "" Then
    If Brow = 0 Then
        Brow = i: Erow = i
        Else
        Erow = i
    End If
Else
    wsopt.Sort.SortFields.Add Key:=Range("C11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
         With wsopt.Sort
        .SetRange Range("A" & Brow & ":O" & Erow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Brow = 0
wsopt.Range("A" & i - 1 & ":O" & i - 1).Copy Destination:=wsopt.Range("A" & i & ":O" & i)
wsopt.Range("A" & i & ":O" & i).Font.ThemeColor = xlThemeColorDark1
End If
Next i
wsopt.Range("P" & 12) = wsopt.Range("D" & 12): Prow = wsopt.Range("D" & 12)
For i = 13 To Rcount
If wsopt.Range("B" & i) = wsopt.Range("B" & i - 1) Then
    wsopt.Range("P" & i) = Prow
Else
    Prow = wsopt.Range("D" & i)
    wsopt.Range("P" & i) = Prow
End If
Next i
wsopt.Sort.SortFields.Clear
wsopt.Sort.SortFields.Add Key:=Range("P11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     
    
    With wsopt.Sort
        .SetRange Range("A11:P" & Rcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
wsopt.Range("B" & 12) = 1: Prow = 1
For i = 13 To Rcount
If wsopt.Range("P" & i) = wsopt.Range("P" & i - 1) Then
    wsopt.Range("B" & i) = Prow
    If wsopt.Range("P" & i) = wsopt.Range("P" & i + 1) Then wsopt.Range("B" & i).Font.Color = -5395027
Else
    Prow = Prow + 1
    wsopt.Range("B" & i) = Prow
End If
Next i
wsopt.Columns("P:P").Delete Shift:=xlToLeft
   
End Sub

Open in new window

0
gowflowCommented:
Well here is the whole code. I am terribly sorry thought I was doing you good in posting the workbook.

Delete the whole code you have in a copy of the workbook for sure so you keep a backup of the original and paste the below code instead.
gowflow
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output.'

'The table data contained in Output is based on the Trade History section of the original tab.'
'It is important to note that the legs (rows) of each spread are numbered and remain in the same order'
'just as they appear in the original tab. The spreads are then numbered as well and moved into'
'individually numbered positions'. When the end user filters the sheet, these positions (which can'
'contain multiple spreads) remain together, and the numbered columns representing the Spread numbers'
'and Position numbers are intended to be hidden for greater readability.'

'Future development will include hiding the Leg and Spread numbers, as well as making some
'calculations on each overall position.'

Const AOH = "Account Order History"
Const ATH = "Account Trade History"
Const PAL = "Profits and Losses"
Const EQT = "Equities"
Const OPT = "Options"
Dim wsopt As Worksheet
    
Sub TradeReport()
    Dim wsPM As Worksheet
    Dim aCell As Range, bCell As Range, cCell As Range, delRange As Range
    Dim AOHRow As Long, PALRow As Long, ATHRow As Long
    Dim LastRow As Long, i As Long, j As Long
    Dim shName As String
    Dim SearchString As String, MatchString As String, init1String As String, init2String As String
    Dim intNum  As Long
    
    On Error GoTo Whoa
    
    Application.ScreenUpdating = False
    
    Set wsPM = ActiveSheet
    
    shName = wsPM.Name
        
    '--> Make New "Output" Sheet if one already exists'
    On Error Resume Next
    Application.DisplayAlerts = False
    Set wsopt = Sheets("Output")
    intNum = 0
    While Err.Number = 0
        Err.Clear
        intNum = intNum + 1
        Set wsopt = Sheets("Output" & intNum)
    Wend
    Err.Clear
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    '--> Recreate "Output" Sheet and move it to the right'
    Set wsopt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    If intNum = 0 Then
        wsopt.Name = "Output"
    Else
        wsopt.Name = "Output" & intNum
    End If
    
    '--> Find the "Account Trade History" cell in Sheet PM'
    Set aCell = wsPM.Columns(1).Find(What:=ATH, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    '--> If "Account Trade History" is found'
    If Not aCell Is Nothing Then
        '--> Get the starting row of "Account Trade History"'
        ATHRow = aCell.Row
        
        '--> Find the "Profits and Losses" cell in Sheet PM'
        Set bCell = wsPM.Columns(1).Find(What:=PAL, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If shName = "rm" Then
            '--> Find the "Equities" cell in Sheet RM'
            Set bCell = wsPM.Columns(1).Find(What:=EQT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        Else
            '--> Find the "Options" cell in Sheet PM'
            Set bCell = wsPM.Columns(1).Find(What:=OPT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        End If
        
        
        '--> If "Profits and Losses" is found'
        If Not bCell Is Nothing Then
            '--> Get the starting row of "Profits and Losses"
            PALRow = bCell.Row
            
            '--> Output Trade History to new tab.'
            wsPM.Rows((ATHRow + 1) & ":" & (PALRow - 1)).Copy wsopt.Rows(1)
            
            If shName = "rm" Then
                wsopt.Select
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
            End If
            
            With wsopt
                '--> Remove last three columns because they are duplicates.'
                .Columns("M:O").Delete Shift:=xlToLeft
                
                '--> Define the notes column.'
                .Range("A1").Value = "Notes"
                .Columns("A:A").Replace What:="DEFAULT", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
                '--> Get the last row of Output Sheet'
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                
                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                'If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1
                    
                '--> Copy the notes into the new notes column.'
                    For i = AOHRow To ATHRow
                        SearchString = wsPM.Range("D" & i).Value & "###" & _
                        wsPM.Range("F" & i).Value & "###" & _
                        wsPM.Range("G" & i).Value & "###" & _
                        wsPM.Range("H" & i).Value & "###" & _
                        wsPM.Range("I" & i).Value
                
                        init1String = wsPM.Range("F" & i).Value
                
                        For j = 2 To LastRow
                            init2String = wsopt.Range("F" & j).Value
                
                            If init1String = init2String Then
                                MatchString = .Range("D" & j).Value & "###" & _
                                              .Range("F" & j).Value & "###" & _
                                              .Range("G" & j).Value & "###" & _
                                              .Range("H" & j).Value & "###" & _
                                              .Range("I" & j).Value
                
                                If MatchString = SearchString Then
                                    .Range("A" & j).Value = wsPM.Range("A" & i).Value
                                End If
                            End If
                        Next j
                    Next i
                End If
                
                '--> Make the Output tab into a table that can be filtered by the column headers.'
                .ListObjects.Add(xlSrcRange, Range("$A$1:$L$" & LastRow), , xlYes).Name = "Table1"
                .ListObjects("Table1").ShowTableStyleRowStripes = False
                'ListObjects("Table1").TableStyle = "TableStyleLight1"'
                .Columns("B:L").EntireColumn.AutoFit
                
            End With
        End If
    End If
    Application.ScreenUpdating = False
    NewUpdates
    Indexing
    Sorting
    Application.ScreenUpdating = True
    
'--> Clean Up and Exit.'
LetsContinue:
    Application.ScreenUpdating = True
    Set aCell = Nothing: Set bCell = Nothing: Set cCell = Nothing: Set delRange = Nothing
    On Error Resume Next
    Set wsopt = Nothing: Set wsPM = Nothing
    On Error GoTo 0
    Exit Sub
    
'--> Error Handling'
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub
Private Sub NewUpdates()
Dim i As Integer

'---> Create extra space at the top of the table of approximately 10 rows.
wsopt.Rows("1:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'---> Modify the date format of the Exec Time column to reflect the format of ddd mmm dd, yyyy hh:mm'
'and the Exp column to reflect the format of mm-yy.'
For i = 12 To wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row
wsopt.Range("B" & i).NumberFormat = "ddd mmm-dd-yyyy hh:mm"
wsopt.Range("G" & i).NumberFormat = "mmm-yy"
Next i

'--> Add Columns for Postion, Spread, and Leg Numbers'
'Add P# column before the Exec Time column with the comment "Position #" in the header for the P# column.'
'Add  S# column between the Exec Time and Spread columns with the comment "Spread #" in the header for the S# column.'
'Add L# column between the Spread and Side columns with the comment "Leg #" in the header for the L# column.'
wsopt.Columns("B:B").Insert Shift:=xlToRight
wsopt.Columns("D:D").Insert Shift:=xlToRight
wsopt.Columns("F:F").Insert Shift:=xlToRight

'---> Format column D and E to number format
wsopt.Range("D12:D" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"
wsopt.Range("F12:F" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"
wsopt.Range("B12:B" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"

'---> Rename the header of the added Position, Spread, and Leg Number columns'
wsopt.Range("B11") = "P#": wsopt.Range("D11") = "S#": wsopt.Range("F11") = "L#"

'---> Set autofit to the width of column D and E
wsopt.Columns("D:D").EntireColumn.AutoFit
wsopt.Columns("F:F").EntireColumn.AutoFit
wsopt.Columns("B:B").EntireColumn.AutoFit
'---> Add comments
wsopt.Range("B11").AddComment
wsopt.Range("B11").Comment.Visible = False
wsopt.Range("B11").Comment.Text Text:="Position No"
wsopt.Range("D11").AddComment
wsopt.Range("D11").Comment.Visible = False
wsopt.Range("D11").Comment.Text Text:="Spread No"
wsopt.Range("F11").AddComment
wsopt.Range("F11").Comment.Visible = False
wsopt.Range("F11").Comment.Text Text:="Leg No"

'---> Shrink the printout so all column will be printed in the same page
'Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
'Application.PrintCommunication = False
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
'Application.PrintCommunication = True

End Sub

Private Sub Indexing()

'--> Indexing macro - The Spread No should be a unique number per Spread (some spreads have multiple
'legs) with the lower numbers on the newest spreads and the highest numbers on the oldest spreads.'
'The legs of each spread should be numbered according to how many rows the Spread has starting'
'with the number 1 and should start over at number 1 again on the next spread. Note that each Spread'
'can have several Legs and Each Position can contain several Spreads. A Spread is part of the same'
'Position if any of it's Legs (rows) contain the same Symbol, Exp, Strike, and Type of any other'
'Spread in the sheet.'


Dim i As Integer, k As Double, z As Double, j As Double, l As Double, test As Boolean, test1 As Boolean
Dim ws As Worksheet, q As Double, Rcount As Double, x As Double, SpreadNo As Double
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = Sheets(Sheets.Count)
k = 0: z = -1: Rcount = wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row: SpreadNo = 0

For i = 12 To Rcount

    If k = 0 And z = -1 Then
        k = k + 1: z = z + 2:
        ws.Cells(k, z) = wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i) & " " & wsopt.Range("K" & i)
        For x = i + 1 To Rcount
        If wsopt.Range("C" & x) = "" Then
            If InStr(1, ws.Cells(k, z), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, z) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
        Else
        Exit For
        End If
        Next x
        ws.Cells(k + 1, z) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
        ws.Cells(k + 1, z + 1) = ws.Cells(k, z + 1) + 1
        wsopt.Range("B" & i) = 1:  wsopt.Range("F" & i) = 1
    Else
        If j = 0 Then j = 1
        If wsopt.Range("C" & i) = "" Then
            test = True
        Else
        test = False: q = -1
    For j = 1 To z Step 2
        q = q + 1
        If InStr(1, ws.Cells(1, j), wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i)) > 0 Then
        If InStr(1, ws.Cells(1, j), wsopt.Range("K" & i)) > 0 Then
            wsopt.Range("B" & i) = j - q: test = True
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, j) = ws.Cells(k, j) & " " & wsopt.Range("K" & x)
            Else
            Exit For
            End If
            Next x
        Else
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) > 0 Then wsopt.Range("B" & i) = j - q: test = True
            Else
            Exit For
            End If
            Next x
            If test = True Then
            ws.Cells(k, j) = ws.Cells(k, j) & " " & wsopt.Range("K" & i)
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, j) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
            Else
            Exit For
            End If
            Next x
            End If
        End If
        
        
        If test = True Then Exit For
        End If
        Next j
        End If
    
    If test = True Then
             l = ws.Cells(ws.Rows.Count, j).End(xlUp).Row + 1
        If wsopt.Range("C" & i) = "" Then
            If j = 0 Then wsopt.Range("B" & i) = 1 Else wsopt.Range("B" & i) = j - q
            ws.Cells(l - 1, j + 1) = ws.Cells(l - 1, j + 1) + 1
            wsopt.Range("F" & i) = ws.Cells(l - 1, j + 1)
        Else
            ws.Cells(l, j) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
            ws.Cells(l, j + 1) = ws.Cells(l, j + 1) + 1
            wsopt.Range("F" & i) = 1
        End If
    Else
        k = 1: z = z + 2: q = q + 1
        ws.Cells(k, z) = wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i) & " " & wsopt.Range("K" & i)
        For x = i + 1 To Rcount
        If wsopt.Range("C" & x) = "" Then
            If InStr(1, ws.Cells(k, z), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, z) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
        Else
        Exit For
        End If
        Next x
        ws.Cells(k + 1, z) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
        ws.Cells(k + 1, z + 1) = ws.Cells(k, z + 1) + 1
        wsopt.Range("B" & i) = z - q: wsopt.Range("F" & i) = 1
    End If
    End If
Next i
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True

'---> The empty cells in the Exec Time and Spread columns should take on the information'
'of the preceding cell because they are part of the same Spread.'

For i = 12 To Rcount
    If wsopt.Range("E" & i) = "" And i > 12 Then
    wsopt.Range("E" & i) = wsopt.Range("E" & i - 1)
    wsopt.Range("C" & i) = wsopt.Range("C" & i - 1)
    wsopt.Range("C" & i & ":E" & i).Font.Color = -5395027
    End If
Next i

wsopt.Sort.SortFields.Add Key:=Range("C11"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        
         With ActiveSheet.Sort
        .SetRange Range("A12:O" & Rcount)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For i = 12 To Rcount
     If wsopt.Range("F" & i) = 1 Then
        SpreadNo = SpreadNo + 1: wsopt.Range("D" & i) = SpreadNo
     Else
     wsopt.Range("D" & i) = SpreadNo
     End If
Next i
 
End Sub

Private Sub Sorting()

'--> This Sort macro is preceeded by the above Indexing macro and should sort by the entire position'
'using the date and time of the last Spreads within that position. It is important that each Leg (row)'
'of each Spread stay in order, and each Spread within the Position stay in order.' The most recent'
'Spread will be at the bottom of each Position and the most recent Position, based on the newest
'spread within it, will be listed above other Positions.'

Dim i As Double, Brow As Double, Erow As Double, Prow As Double
Dim Rcount As Double


On Error Resume Next
 Rcount = wsopt.Cells(wsopt.Rows.Count, "B").End(xlUp).Row
 '---> Sorting the output by the Position No.
    wsopt.Sort.SortFields.Clear
    wsopt.Sort.SortFields.Add Key:=Range("B11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     
    
    With wsopt.Sort
        .SetRange Range("A11:O" & Rcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'--> Skipping a row between each major position
For i = Rcount To 13 Step -1
If Range("B" & i) <> Range("B" & i - 1) And Range("B" & i) <> "" Then
wsopt.Rows(i & Chr(58) & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i

'---> Sorting the output by Date descending
 Brow = 0
For i = 12 To Rcount
If wsopt.Range("B" & i) <> "" Then
    If Brow = 0 Then
        Brow = i: Erow = i
        Else
        Erow = i
    End If
Else
    wsopt.Sort.SortFields.Add Key:=Range("C11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
         With wsopt.Sort
        .SetRange Range("A" & Brow & ":O" & Erow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Brow = 0
wsopt.Range("A" & i - 1 & ":O" & i - 1).Copy Destination:=wsopt.Range("A" & i & ":O" & i)
wsopt.Range("A" & i & ":O" & i).Font.ThemeColor = xlThemeColorDark1
End If
Next i
wsopt.Range("P" & 12) = wsopt.Range("D" & 12): Prow = wsopt.Range("D" & 12)
For i = 13 To Rcount
If wsopt.Range("B" & i) = wsopt.Range("B" & i - 1) Then
    wsopt.Range("P" & i) = Prow
Else
    Prow = wsopt.Range("D" & i)
    wsopt.Range("P" & i) = Prow
End If
Next i
wsopt.Sort.SortFields.Clear
wsopt.Sort.SortFields.Add Key:=Range("P11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     
    
    With wsopt.Sort
        .SetRange Range("A11:P" & Rcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
wsopt.Range("B" & 12) = 1: Prow = 1
For i = 13 To Rcount
If wsopt.Range("P" & i) = wsopt.Range("P" & i - 1) Then
    wsopt.Range("B" & i) = Prow
    If wsopt.Range("P" & i) = wsopt.Range("P" & i + 1) Then wsopt.Range("B" & i).Font.Color = -5395027
Else
    Prow = Prow + 1
    wsopt.Range("B" & i) = Prow
End If
Next i
wsopt.Columns("P:P").Delete Shift:=xlToLeft
   
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
rtod2Author Commented:
gowflow, Thank you sir!

The code works now without messing up any of the formatting!  However, back to my original question about how to remove the whole section below that was put there to eliminate rows that are no longer being eliminated. Can that 'entire' section be removed now?

                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                'If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1

Open in new window

0
rtod2Author Commented:
Thank you for your help sir!  I was able to remove part of it and that's good enough for me moving forward.  Excellent work sir.
0
gowflowCommented:
You can safely remove below code from what you posted ie from line 1 to line 15
gowflow
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output.'

'The table data contained in Output is based on the Trade History section of the original tab.'
'It is important to note that the legs (rows) of each spread are numbered and remain in the same order'
'just as they appear in the original tab. The spreads are then numbered as well and moved into'
'individually numbered positions'. When the end user filters the sheet, these positions (which can'
'contain multiple spreads) remain together, and the numbered columns representing the Spread numbers'
'and Position numbers are intended to be hidden for greater readability.'

'Future development will include hiding the Leg and Spread numbers, as well as making some
'calculations on each overall position.'

Const AOH = "Account Order History"
Const ATH = "Account Trade History"
Const PAL = "Profits and Losses"
Const EQT = "Equities"
Const OPT = "Options"
Dim wsopt As Worksheet
    
Sub TradeReport()
    Dim wsPM As Worksheet
    Dim aCell As Range, bCell As Range, cCell As Range, delRange As Range
    Dim AOHRow As Long, PALRow As Long, ATHRow As Long
    Dim LastRow As Long, i As Long, j As Long
    Dim shName As String
    Dim SearchString As String, MatchString As String, init1String As String, init2String As String
    Dim intNum  As Long
    
    On Error GoTo Whoa
    
    Application.ScreenUpdating = False
    
    Set wsPM = ActiveSheet
    
    shName = wsPM.Name
        
    '--> Make New "Output" Sheet if one already exists'
    On Error Resume Next
    Application.DisplayAlerts = False
    Set wsopt = Sheets("Output")
    intNum = 0
    While Err.Number = 0
        Err.Clear
        intNum = intNum + 1
        Set wsopt = Sheets("Output" & intNum)
    Wend
    Err.Clear
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    '--> Recreate "Output" Sheet and move it to the right'
    Set wsopt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    If intNum = 0 Then
        wsopt.Name = "Output"
    Else
        wsopt.Name = "Output" & intNum
    End If
    
    '--> Find the "Account Trade History" cell in Sheet PM'
    Set aCell = wsPM.Columns(1).Find(What:=ATH, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
    '--> If "Account Trade History" is found'
    If Not aCell Is Nothing Then
        '--> Get the starting row of "Account Trade History"'
        ATHRow = aCell.Row
        
        '--> Find the "Profits and Losses" cell in Sheet PM'
        Set bCell = wsPM.Columns(1).Find(What:=PAL, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If shName = "rm" Then
            '--> Find the "Equities" cell in Sheet RM'
            Set bCell = wsPM.Columns(1).Find(What:=EQT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        Else
            '--> Find the "Options" cell in Sheet PM'
            Set bCell = wsPM.Columns(1).Find(What:=OPT, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        End If
        
        
        '--> If "Profits and Losses" is found'
        If Not bCell Is Nothing Then
            '--> Get the starting row of "Profits and Losses"
            PALRow = bCell.Row
            
            '--> Output Trade History to new tab.'
            wsPM.Rows((ATHRow + 1) & ":" & (PALRow - 1)).Copy wsopt.Rows(1)
            
            If shName = "rm" Then
                wsopt.Select
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight
            End If
            
            With wsopt
                '--> Remove last three columns because they are duplicates.'
                .Columns("M:O").Delete Shift:=xlToLeft
                
                '--> Define the notes column.'
                .Range("A1").Value = "Notes"
                .Columns("A:A").Replace What:="DEFAULT", Replacement:="", LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
                '--> Get the last row of Output Sheet'
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                
                '--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                'If Not delRange Is Nothing Then delRange.Delete
                
                LastRow = .Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious).Row
                          
                Set cCell = wsPM.Columns(1).Find(What:=AOH, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
                If Not cCell Is Nothing Then
                    AOHRow = cCell.Row + 1
                    
                '--> Copy the notes into the new notes column.'
                    For i = AOHRow To ATHRow
                        SearchString = wsPM.Range("D" & i).Value & "###" & _
                        wsPM.Range("F" & i).Value & "###" & _
                        wsPM.Range("G" & i).Value & "###" & _
                        wsPM.Range("H" & i).Value & "###" & _
                        wsPM.Range("I" & i).Value
                
                        init1String = wsPM.Range("F" & i).Value
                
                        For j = 2 To LastRow
                            init2String = wsopt.Range("F" & j).Value
                
                            If init1String = init2String Then
                                MatchString = .Range("D" & j).Value & "###" & _
                                              .Range("F" & j).Value & "###" & _
                                              .Range("G" & j).Value & "###" & _
                                              .Range("H" & j).Value & "###" & _
                                              .Range("I" & j).Value
                
                                If MatchString = SearchString Then
                                    .Range("A" & j).Value = wsPM.Range("A" & i).Value
                                End If
                            End If
                        Next j
                    Next i
                End If
                
                '--> Make the Output tab into a table that can be filtered by the column headers.'
                .ListObjects.Add(xlSrcRange, Range("$A$1:$L$" & LastRow), , xlYes).Name = "Table1"
                .ListObjects("Table1").ShowTableStyleRowStripes = False
                'ListObjects("Table1").TableStyle = "TableStyleLight1"'
                .Columns("B:L").EntireColumn.AutoFit
                
            End With
        End If
    End If
    Application.ScreenUpdating = False
    NewUpdates
    Indexing
    Sorting
    Application.ScreenUpdating = True
    
'--> Clean Up and Exit.'
LetsContinue:
    Application.ScreenUpdating = True
    Set aCell = Nothing: Set bCell = Nothing: Set cCell = Nothing: Set delRange = Nothing
    On Error Resume Next
    Set wsopt = Nothing: Set wsPM = Nothing
    On Error GoTo 0
    Exit Sub
    
'--> Error Handling'
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub
Private Sub NewUpdates()
Dim i As Integer

'---> Create extra space at the top of the table of approximately 10 rows.
wsopt.Rows("1:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'---> Modify the date format of the Exec Time column to reflect the format of ddd mmm dd, yyyy hh:mm'
'and the Exp column to reflect the format of mm-yy.'
For i = 12 To wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row
wsopt.Range("B" & i).NumberFormat = "ddd mmm-dd-yyyy hh:mm"
wsopt.Range("G" & i).NumberFormat = "mmm-yy"
Next i

'--> Add Columns for Postion, Spread, and Leg Numbers'
'Add P# column before the Exec Time column with the comment "Position #" in the header for the P# column.'
'Add  S# column between the Exec Time and Spread columns with the comment "Spread #" in the header for the S# column.'
'Add L# column between the Spread and Side columns with the comment "Leg #" in the header for the L# column.'
wsopt.Columns("B:B").Insert Shift:=xlToRight
wsopt.Columns("D:D").Insert Shift:=xlToRight
wsopt.Columns("F:F").Insert Shift:=xlToRight

'---> Format column D and E to number format
wsopt.Range("D12:D" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"
wsopt.Range("F12:F" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"
wsopt.Range("B12:B" & wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row).NumberFormat = "0"

'---> Rename the header of the added Position, Spread, and Leg Number columns'
wsopt.Range("B11") = "P#": wsopt.Range("D11") = "S#": wsopt.Range("F11") = "L#"

'---> Set autofit to the width of column D and E
wsopt.Columns("D:D").EntireColumn.AutoFit
wsopt.Columns("F:F").EntireColumn.AutoFit
wsopt.Columns("B:B").EntireColumn.AutoFit
'---> Add comments
wsopt.Range("B11").AddComment
wsopt.Range("B11").Comment.Visible = False
wsopt.Range("B11").Comment.Text Text:="Position No"
wsopt.Range("D11").AddComment
wsopt.Range("D11").Comment.Visible = False
wsopt.Range("D11").Comment.Text Text:="Spread No"
wsopt.Range("F11").AddComment
wsopt.Range("F11").Comment.Visible = False
wsopt.Range("F11").Comment.Text Text:="Leg No"

'---> Shrink the printout so all column will be printed in the same page
'Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
'Application.PrintCommunication = False
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
'Application.PrintCommunication = True

End Sub

Private Sub Indexing()

'--> Indexing macro - The Spread No should be a unique number per Spread (some spreads have multiple
'legs) with the lower numbers on the newest spreads and the highest numbers on the oldest spreads.'
'The legs of each spread should be numbered according to how many rows the Spread has starting'
'with the number 1 and should start over at number 1 again on the next spread. Note that each Spread'
'can have several Legs and Each Position can contain several Spreads. A Spread is part of the same'
'Position if any of it's Legs (rows) contain the same Symbol, Exp, Strike, and Type of any other'
'Spread in the sheet.'


Dim i As Integer, k As Double, z As Double, j As Double, l As Double, test As Boolean, test1 As Boolean
Dim ws As Worksheet, q As Double, Rcount As Double, x As Double, SpreadNo As Double
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = Sheets(Sheets.Count)
k = 0: z = -1: Rcount = wsopt.Cells(wsopt.Rows.Count, "K").End(xlUp).Row: SpreadNo = 0

For i = 12 To Rcount

    If k = 0 And z = -1 Then
        k = k + 1: z = z + 2:
        ws.Cells(k, z) = wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i) & " " & wsopt.Range("K" & i)
        For x = i + 1 To Rcount
        If wsopt.Range("C" & x) = "" Then
            If InStr(1, ws.Cells(k, z), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, z) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
        Else
        Exit For
        End If
        Next x
        ws.Cells(k + 1, z) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
        ws.Cells(k + 1, z + 1) = ws.Cells(k, z + 1) + 1
        wsopt.Range("B" & i) = 1:  wsopt.Range("F" & i) = 1
    Else
        If j = 0 Then j = 1
        If wsopt.Range("C" & i) = "" Then
            test = True
        Else
        test = False: q = -1
    For j = 1 To z Step 2
        q = q + 1
        If InStr(1, ws.Cells(1, j), wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i)) > 0 Then
        If InStr(1, ws.Cells(1, j), wsopt.Range("K" & i)) > 0 Then
            wsopt.Range("B" & i) = j - q: test = True
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, j) = ws.Cells(k, j) & " " & wsopt.Range("K" & x)
            Else
            Exit For
            End If
            Next x
        Else
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) > 0 Then wsopt.Range("B" & i) = j - q: test = True
            Else
            Exit For
            End If
            Next x
            If test = True Then
            ws.Cells(k, j) = ws.Cells(k, j) & " " & wsopt.Range("K" & i)
            For x = i + 1 To Rcount
            If wsopt.Range("C" & x) = "" Then
                If InStr(1, ws.Cells(k, j), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, j) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
            Else
            Exit For
            End If
            Next x
            End If
        End If
        
        
        If test = True Then Exit For
        End If
        Next j
        End If
    
    If test = True Then
             l = ws.Cells(ws.Rows.Count, j).End(xlUp).Row + 1
        If wsopt.Range("C" & i) = "" Then
            If j = 0 Then wsopt.Range("B" & i) = 1 Else wsopt.Range("B" & i) = j - q
            ws.Cells(l - 1, j + 1) = ws.Cells(l - 1, j + 1) + 1
            wsopt.Range("F" & i) = ws.Cells(l - 1, j + 1)
        Else
            ws.Cells(l, j) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
            ws.Cells(l, j + 1) = ws.Cells(l, j + 1) + 1
            wsopt.Range("F" & i) = 1
        End If
    Else
        k = 1: z = z + 2: q = q + 1
        ws.Cells(k, z) = wsopt.Range("I" & i) & wsopt.Range("J" & i) & wsopt.Range("L" & i) & " " & wsopt.Range("K" & i)
        For x = i + 1 To Rcount
        If wsopt.Range("C" & x) = "" Then
            If InStr(1, ws.Cells(k, z), wsopt.Range("K" & x)) = 0 Then ws.Cells(k, z) = ws.Cells(k, z) & " " & wsopt.Range("K" & x)
        Else
        Exit For
        End If
        Next x
        ws.Cells(k + 1, z) = wsopt.Range("C" & i) & wsopt.Range("E" & i)
        ws.Cells(k + 1, z + 1) = ws.Cells(k, z + 1) + 1
        wsopt.Range("B" & i) = z - q: wsopt.Range("F" & i) = 1
    End If
    End If
Next i
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True

'---> The empty cells in the Exec Time and Spread columns should take on the information'
'of the preceding cell because they are part of the same Spread.'

For i = 12 To Rcount
    If wsopt.Range("E" & i) = "" And i > 12 Then
    wsopt.Range("E" & i) = wsopt.Range("E" & i - 1)
    wsopt.Range("C" & i) = wsopt.Range("C" & i - 1)
    wsopt.Range("C" & i & ":E" & i).Font.Color = -5395027
    End If
Next i

wsopt.Sort.SortFields.Add Key:=Range("C11"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        
         With ActiveSheet.Sort
        .SetRange Range("A12:O" & Rcount)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For i = 12 To Rcount
     If wsopt.Range("F" & i) = 1 Then
        SpreadNo = SpreadNo + 1: wsopt.Range("D" & i) = SpreadNo
     Else
     wsopt.Range("D" & i) = SpreadNo
     End If
Next i
 
End Sub

Private Sub Sorting()

'--> This Sort macro is preceeded by the above Indexing macro and should sort by the entire position'
'using the date and time of the last Spreads within that position. It is important that each Leg (row)'
'of each Spread stay in order, and each Spread within the Position stay in order.' The most recent'
'Spread will be at the bottom of each Position and the most recent Position, based on the newest
'spread within it, will be listed above other Positions.'

Dim i As Double, Brow As Double, Erow As Double, Prow As Double
Dim Rcount As Double


On Error Resume Next
 Rcount = wsopt.Cells(wsopt.Rows.Count, "B").End(xlUp).Row
 '---> Sorting the output by the Position No.
    wsopt.Sort.SortFields.Clear
    wsopt.Sort.SortFields.Add Key:=Range("B11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     
    
    With wsopt.Sort
        .SetRange Range("A11:O" & Rcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'--> Skipping a row between each major position
For i = Rcount To 13 Step -1
If Range("B" & i) <> Range("B" & i - 1) And Range("B" & i) <> "" Then
wsopt.Rows(i & Chr(58) & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next i

'---> Sorting the output by Date descending
 Brow = 0
For i = 12 To Rcount
If wsopt.Range("B" & i) <> "" Then
    If Brow = 0 Then
        Brow = i: Erow = i
        Else
        Erow = i
    End If
Else
    wsopt.Sort.SortFields.Add Key:=Range("C11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
         With wsopt.Sort
        .SetRange Range("A" & Brow & ":O" & Erow)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Brow = 0
wsopt.Range("A" & i - 1 & ":O" & i - 1).Copy Destination:=wsopt.Range("A" & i & ":O" & i)
wsopt.Range("A" & i & ":O" & i).Font.ThemeColor = xlThemeColorDark1
End If
Next i
wsopt.Range("P" & 12) = wsopt.Range("D" & 12): Prow = wsopt.Range("D" & 12)
For i = 13 To Rcount
If wsopt.Range("B" & i) = wsopt.Range("B" & i - 1) Then
    wsopt.Range("P" & i) = Prow
Else
    Prow = wsopt.Range("D" & i)
    wsopt.Range("P" & i) = Prow
End If
Next i
wsopt.Sort.SortFields.Clear
wsopt.Sort.SortFields.Add Key:=Range("P11"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
     
    
    With wsopt.Sort
        .SetRange Range("A11:P" & Rcount)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
wsopt.Range("B" & 12) = 1: Prow = 1
For i = 13 To Rcount
If wsopt.Range("P" & i) = wsopt.Range("P" & i - 1) Then
    wsopt.Range("B" & i) = Prow
    If wsopt.Range("P" & i) = wsopt.Range("P" & i + 1) Then wsopt.Range("B" & i).Font.Color = -5395027
Else
    Prow = Prow + 1
    wsopt.Range("B" & i) = Prow
End If
Next i
wsopt.Columns("P:P").Delete Shift:=xlToLeft
   
End Sub

Open in new window

0
gowflowCommented:
ooops pls disregard my previous post and use this: you can safely remove below code
gowflow
'--> Remove weekly and quarterly spreads based on the format of the exp column.'
                For i = 2 To LastRow
                    If Not IsDate(.Range("G" & i).Value) Then
                        If delRange Is Nothing Then
                            Set delRange = .Rows(i)
                        Else
                            Set delRange = Union(delRange, .Rows(i))
                        End If
                        If Len(Trim(.Range("G" & i).Offset(1, -4).Value)) = 0 Then
                            Set delRange = Union(delRange, .Rows(i + 1))
                        End If
                    End If
                Next i
            
                'If Not delRange Is Nothing Then delRange.Delete

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.