rtod2
asked on
Fix issue with date format of column
I need to use a "date format" in the Exp column pictured below the macro for this Excel sheet. Please don't upload the original file if you can help it. I greatly appreciate the assistance.
Note that Exp stands for Expiration. The problem is that sometimes there is an Expiration date, where other times only the month and year are shown. I need to use the column as a date column due to some other processing we will be doing and need to process the column correctly. Previously this question had been confused with some other issues that have since been resolved. That is to say, that we have cleaner data now so the resolution should be easier.
The challenge is as follows:
Denote Exp month and year only for standard options: Dec-11 (mmm-yy)
Denote Exp date, month and year for weekly or quarterly options: Dec-8-11 (mmm-dd-yy)
Note that Exp stands for Expiration. The problem is that sometimes there is an Expiration date, where other times only the month and year are shown. I need to use the column as a date column due to some other processing we will be doing and need to process the column correctly. Previously this question had been confused with some other issues that have since been resolved. That is to say, that we have cleaner data now so the resolution should be easier.
The challenge is as follows:
Denote Exp month and year only for standard options: Dec-11 (mmm-yy)
Denote Exp date, month and year for weekly or quarterly options: Dec-8-11 (mmm-dd-yy)
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningfull positions.'
'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
'--> Unsure of what this section does?'
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
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next i
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
For i = 12 To Rcount + 1
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.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
date-format.png
ok here it is based on my previous assumption in the earlier post.
here is how to implement.
1) Make a fresh copy of the latest version of your file and give it to a new name.
2) Open VBA and paste the below new Sub FixDate after any end sub in module1
3) display the sub TradeReport and scroll toward the end when you see these lines
...
========================== =====
Application.ScreenUpdating = False
NewUpdates
Indexing
Sorting
Application.ScreenUpdating = True
========================== ==
Insert the newly created sub FixDate so that the whole sequence become as follows:
========================== ===
Application.ScreenUpdating = False
NewUpdates
Indexing
Sorting
FixDate
Application.ScreenUpdating = True
========================== ====
4) SAVE and exit the workbook.
5) Start the workbook and give it a try.
Pls let me know.
gowflow
here is how to implement.
1) Make a fresh copy of the latest version of your file and give it to a new name.
2) Open VBA and paste the below new Sub FixDate after any end sub in module1
3) display the sub TradeReport and scroll toward the end when you see these lines
...
==========================
Application.ScreenUpdating
NewUpdates
Indexing
Sorting
Application.ScreenUpdating
==========================
Insert the newly created sub FixDate so that the whole sequence become as follows:
==========================
Application.ScreenUpdating
NewUpdates
Indexing
Sorting
FixDate
Application.ScreenUpdating
==========================
4) SAVE and exit the workbook.
5) Start the workbook and give it a try.
Pls let me know.
gowflow
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix date as follows
'Denote Exp month and year only for standard options: Dec-11 (mmm-yy)
'Denote Exp date, month and year for weekly or quarterly options: Dec-8-11 (mmm-dd-yy)
'fixed by gowflow on EE on 14-Dec-2011
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
ASKER
gowflow, thank you.
I appreciate all the introductory stuff but I see how the subroutines fit together and I know how to rename sheets. There is no need to go through all of the description each time on how to make a new sheet, but I definitely appreciate the effort.
What I got out of what you said was the following.
1. Add your subroutine to the bottom of my code.
2. Change the Application.ScreenUpdating so that it is equal to True instead of False.
Based on that interpretation of your instructions, I have the resulting code below which still does not seem to change the way the dates are displayed. I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this screenshot.
I have pasted my full code below and further assistance is greatly appreciated.
I appreciate all the introductory stuff but I see how the subroutines fit together and I know how to rename sheets. There is no need to go through all of the description each time on how to make a new sheet, but I definitely appreciate the effort.
What I got out of what you said was the following.
1. Add your subroutine to the bottom of my code.
2. Change the Application.ScreenUpdating
Based on that interpretation of your instructions, I have the resulting code below which still does not seem to change the way the dates are displayed. I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this screenshot.
I have pasted my full code below and further 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 with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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 = True
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
'--> Unsure of what this section does?'
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
ActiveSheet.PageSetup.PrintArea = ""
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
For I = 12 To Rcount + 1
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.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
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix the date to allow for either mm-yy or mmm-dd-yy.
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
ASKER
growflow,
Thank you again. Please ignore my previous post. I got it now. I think, but am not certain that I got the Application.ScreenUpdating right now as it is referenced in several places. I had mucked it up pretty badly.
I notice now that it does run but turns what should be a 2 for the second of the month into an 11 which is incorrect. The original result is here http://screencast.com/t/scvULeg2C0p.
I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this screenshot.
For the sake of clarity, if you could re-paste the entire code block for all subroutines just in this next post, it might be helpful to me.
Thank you again. Please ignore my previous post. I got it now. I think, but am not certain that I got the Application.ScreenUpdating
I notice now that it does run but turns what should be a 2 for the second of the month into an 11 which is incorrect. The original result is here http://screencast.com/t/scvULeg2C0p.
I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this screenshot.
For the sake of clarity, if you could re-paste the entire code block for all subroutines just in this next post, it might be helpful to me.
here is the whole code. Sorry If I confused you bu nothing was changed in the screenupdating !! only adding FixDate in there !!
Anyway delete the whole code you have and replace by this one.
gowflow
Anyway delete the whole code you have and replace by this one.
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
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix date as follows
'Denote Exp month and year only for standard options: Dec-11 (mmm-yy)
'Denote Exp date, month and year for weekly or quarterly options: Dec-8-11 (mmm-dd-yy)
'fixed by gowflow on EE on 14-Dec-2011
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
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
FixDate
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
'added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'---> Sorting the output by Date descending
Brow = 0
'Changed by gowflow from upper Rcount to Rcount +1
For I = 12 To Rcount + 1
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
'Disabled this section by gowflow as redundant
'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
ASKER
growflow,
Thank you again but you are clearly using older code than what I have re-pasted below. I had corrected many of the comments and some other things. Please modify IT if possible with the following bugs in mind as well.
1. I notice now that it does run but turns what should be a 2 for the second of the month into an 11 which is incorrect. The original result is here http://screencast.com/t/scvULeg2C0p.
2. I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this screenshot.
most current code below:
Thank you again but you are clearly using older code than what I have re-pasted below. I had corrected many of the comments and some other things. Please modify IT if possible with the following bugs in mind as well.
1. I notice now that it does run but turns what should be a 2 for the second of the month into an 11 which is incorrect. The original result is here http://screencast.com/t/scvULeg2C0p.
2. I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this screenshot.
most current code below:
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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 = True
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
'--> Unsure of what this section does?'
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
ActiveSheet.PageSetup.PrintArea = ""
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
For I = 12 To Rcount + 1
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.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
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix the date to allow for either mm-yy or mmm-dd-yy.
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
Sorry I am lost !!1
In here I don't get errors but noticed that all your dates are day 11 and found that weired !!
What code you want to me to look at I worked on the previous code I had didn't know you had changed it in between !!!!
we can't be 2 cooks !!! you need to tell me.
I can look at your code again but PLEASE !!! when I work on the code refrain from making corrections. Please post in the next thread the whole code and I will look at it then
gowflow
In here I don't get errors but noticed that all your dates are day 11 and found that weired !!
What code you want to me to look at I worked on the previous code I had didn't know you had changed it in between !!!!
we can't be 2 cooks !!! you need to tell me.
I can look at your code again but PLEASE !!! when I work on the code refrain from making corrections. Please post in the next thread the whole code and I will look at it then
gowflow
ASKER
The code is in my last comment.
I think I know what is the problem my computer default date is mm/dd/yy it seems yours is dd/mm/yy reason why all dates shows 11 to be november is this correct that your pc is dd/mm/yy ? I mean the window default
gowflow
gowflow
ASKER
Don't know??
ASKER
I am in the United States, using Windows 7, and Excel 2010. In the interest of clarity, I have restated where we are currently as well as the most recent code.
Challenge:
Change the format of the Exp column to show either format mmm-yy or mmm-dd-yy as needed.
Bugs encountered while trying to resolve the challenge:
1. I notice now that it does run but turns what should be a 2 for the second of the month into an 11 which is incorrect. The original resulting screenshot is here http://screencast.com/t/scvULeg2C0p.
2. I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this resulting screenshot http://screencast.com/t/UddSEvIlH.
Most current code:
Challenge:
Change the format of the Exp column to show either format mmm-yy or mmm-dd-yy as needed.
Bugs encountered while trying to resolve the challenge:
1. I notice now that it does run but turns what should be a 2 for the second of the month into an 11 which is incorrect. The original resulting screenshot is here http://screencast.com/t/scvULeg2C0p.
2. I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this resulting screenshot http://screencast.com/t/UddSEvIlH.
Most current code:
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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 = True
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
'--> Unsure of what this section does?'
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
ActiveSheet.PageSetup.PrintArea = ""
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
For I = 12 To Rcount + 1
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.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
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix the date to allow for either mm-yy or mmm-dd-yy.
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
well youd better know I suspect it is this way this is why the whole data (I mean in Column J I am talking the rest is fine) if you confirm it is then I will re-construct the data in this column for it to be this way.
By the way I am not getting any error with the code you posted it was missing FixDate that I added but I am getting a weired error I never ever in my life got when I run your macro and save the file when I open it again I get a message file is unreadable do you want to recover I say yes then it prompt to save it with a link to an xml file !!! weired are you getting this ??/
here is the entire code incorporating the fixdate but still without it beeing fixed for day/month/year that will need your confirmation.
gowflow
By the way I am not getting any error with the code you posted it was missing FixDate that I added but I am getting a weired error I never ever in my life got when I run your macro and save the file when I open it again I get a message file is unreadable do you want to recover I say yes then it prompt to save it with a link to an xml file !!! weired are you getting this ??/
here is the entire code incorporating the fixdate but still without it beeing fixed for day/month/year that will need your confirmation.
gowflow
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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 = True
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
'--> Unsure of what this section does?'
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
FixDate
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
ActiveSheet.PageSetup.PrintArea = ""
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
For I = 12 To Rcount + 1
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.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
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix the date to allow for either mm-yy or mmm-dd-yy.
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
ASKER
Sorry to have frustrated you sir but yes, I am getting the same bugs you are.
It appears that our posts crossed. I don't know whether I have answered your question about the time adequately. The is a screenshot of what I see when I mouse-over my clock http://screencast.com/t/hsFR8nX0XyJ.
I would prefer to stay standard for U.S. Windows 7 and Excel 2010.
To restate our challenge:
Change the format of the Exp column to show either format mmm-yy or mmm-dd-yy as needed.
Bugs encountered while trying to resolve the challenge:
1. I notice now that it turns what should be a 2 for the second of the month into an 11 which is incorrect. The resulting screenshot is here http://screencast.com/t/scvULeg2C0p.
2. I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this resulting screenshot http://screencast.com/t/UddSEvIlH which is the same as what you mentioned in your post.
Latest code:
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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 = True
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:=Work sheets(Wor ksheets.Co unt))
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:=xlPreviou s).Row
'--> Unsure of what this section does?'
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(xlSrcRang e, Range("$A$1:$L$" & LastRow), , xlYes).Name = "Table1"
.ListObjects("Table1").Sho wTableStyl eRowStripe s = False
'ListObjects("Table1").Tab leStyle = "TableStyleLight1"'
.Columns("B:L").EntireColu mn.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:=xlFormatFromLe ftOrAbove
'---> 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.Cou nt, "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").Inser t Shift:=xlToRight
wsopt.Columns("D:D").Inser t Shift:=xlToRight
wsopt.Columns("F:F").Inser t Shift:=xlToRight
'---> Format column D and E to number format
wsopt.Range("D12:D" & wsopt.Cells(wsopt.Rows.Cou nt, "K").End(xlUp).Row).Number Format = "0"
wsopt.Range("F12:F" & wsopt.Cells(wsopt.Rows.Cou nt, "K").End(xlUp).Row).Number Format = "0"
wsopt.Range("B12:B" & wsopt.Cells(wsopt.Rows.Cou nt, "K").End(xlUp).Row).Number Format = "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").Entir eColumn.Au toFit
wsopt.Columns("F:F").Entir eColumn.Au toFit
wsopt.Columns("B:B").Entir eColumn.Au toFit
'---> Add comments
wsopt.Range("B11").AddComm ent
wsopt.Range("B11").Comment .Visible = False
wsopt.Range("B11").Comment .Text Text:="Position No"
wsopt.Range("D11").AddComm ent
wsopt.Range("D11").Comment .Visible = False
wsopt.Range("D11").Comment .Text Text:="Spread No"
wsopt.Range("F11").AddComm ent
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
ActiveSheet.PageSetup.Prin tArea = ""
wsopt.PageSetup.FitToPages Wide = 1
wsopt.PageSetup.FitToPages Tall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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.Cou nt, "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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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.Cou nt, "B").End(xlUp).Row
'---> Sorting the output by the Position No.
wsopt.Sort.SortFields.Clea r
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:=xlFormatFromLe ftOrAbove
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
For I = 12 To Rcount + 1
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.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").Delet e Shift:=xlToLeft
End Sub
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix the date to allow for either mm-yy or mmm-dd-yy.
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Coun t).End(xlU p).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
It appears that our posts crossed. I don't know whether I have answered your question about the time adequately. The is a screenshot of what I see when I mouse-over my clock http://screencast.com/t/hsFR8nX0XyJ.
I would prefer to stay standard for U.S. Windows 7 and Excel 2010.
To restate our challenge:
Change the format of the Exp column to show either format mmm-yy or mmm-dd-yy as needed.
Bugs encountered while trying to resolve the challenge:
1. I notice now that it turns what should be a 2 for the second of the month into an 11 which is incorrect. The resulting screenshot is here http://screencast.com/t/scvULeg2C0p.
2. I also notice that when I try to re-open a sheet that has a new output tab, I get an error that looks like this resulting screenshot http://screencast.com/t/UddSEvIlH which is the same as what you mentioned in your post.
Latest code:
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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
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:=Work
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:
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:
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:
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:
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:=xlPreviou
'--> Unsure of what this section does?'
Set cCell = wsPM.Columns(1).Find(What:
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(xlSrcRang
.ListObjects("Table1").Sho
'ListObjects("Table1").Tab
.Columns("B:L").EntireColu
End With
End If
End If
Application.ScreenUpdating
NewUpdates
Indexing
Sorting
Application.ScreenUpdating
'--> Clean Up and Exit.'
LetsContinue:
Application.ScreenUpdating
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:=xlFormatFromLe
'---> 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.Cou
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").Inser
wsopt.Columns("D:D").Inser
wsopt.Columns("F:F").Inser
'---> Format column D and E to number format
wsopt.Range("D12:D" & wsopt.Cells(wsopt.Rows.Cou
wsopt.Range("F12:F" & wsopt.Cells(wsopt.Rows.Cou
wsopt.Range("B12:B" & wsopt.Cells(wsopt.Rows.Cou
'---> 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").Entir
wsopt.Columns("F:F").Entir
wsopt.Columns("B:B").Entir
'---> Add comments
wsopt.Range("B11").AddComm
wsopt.Range("B11").Comment
wsopt.Range("B11").Comment
wsopt.Range("D11").AddComm
wsopt.Range("D11").Comment
wsopt.Range("D11").Comment
wsopt.Range("F11").AddComm
wsopt.Range("F11").Comment
wsopt.Range("F11").Comment
'---> Shrink the printout so all column will be printed in the same page
ActiveSheet.PageSetup.Prin
wsopt.PageSetup.FitToPages
wsopt.PageSetup.FitToPages
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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.Cou
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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.Cou
'---> Sorting the output by the Position No.
wsopt.Sort.SortFields.Clea
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:=xlFormatFromLe
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
For I = 12 To Rcount + 1
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("
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.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").Delet
End Sub
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix the date to allow for either mm-yy or mmm-dd-yy.
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Coun
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
ASKER
gowflow,
Does that answer your question?
I don't know whether I have answered your question about the time adequately. The is a screenshot of what I see when I mouse-over my clock http://screencast.com/t/hsFR8nX0XyJ.
I would prefer to stay standard for U.S. Windows 7 and Excel 2010.
I did not mean to post without the code tags. Here is the complete code that you pasted in Post ID#37286990 above where you said "here is the entire code incorporating the FixDate but still without it being fixed for day/month/year that will need your confirmation - gowflow."
I need to know if I have adequately answered your question?
Does that answer your question?
I don't know whether I have answered your question about the time adequately. The is a screenshot of what I see when I mouse-over my clock http://screencast.com/t/hsFR8nX0XyJ.
I would prefer to stay standard for U.S. Windows 7 and Excel 2010.
I did not mean to post without the code tags. Here is the complete code that you pasted in Post ID#37286990 above where you said "here is the entire code incorporating the FixDate but still without it being fixed for day/month/year that will need your confirmation - gowflow."
I need to know if I have adequately answered your question?
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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 = True
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
'--> Unsure of what this section does?'
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
FixDate
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
ActiveSheet.PageSetup.PrintArea = ""
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
For I = 12 To Rcount + 1
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.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
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix the date to allow for either mm-yy or mmm-dd-yy.
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
About the date format :
NO your mouse hoovering does not answer the question to anser it do the following:
Click on START then choose control Panel the choose from the list Region anf Settings when it opens in the Formats tab pls tell me what is the Short date format I suspect yours to be d/M/yyyy while mine is M/d/yyyy
if it is same date format as mine then I would have following conclusion: The data you have in the file is probably dumped from a certain location or computer as you have 2 dates in this file date in rm and pm that have the time are correct but the problem lies with the date that is in col F for rm and G for PM and in the Output sheets the column J Exp that need formating I suspect this column's value comes from a computer that has d/M/yyyy format and as it is not formated as real date it is beeing mis interpreted by the macro. I need confirmation on this.
As far as the code is concerned I am lost with your zillion posting of codes I will work with hte last version you posted prior to this one. Please STOP changing the code whileI am working as then fear cannot assist you further.
gowflow
NO your mouse hoovering does not answer the question to anser it do the following:
Click on START then choose control Panel the choose from the list Region anf Settings when it opens in the Formats tab pls tell me what is the Short date format I suspect yours to be d/M/yyyy while mine is M/d/yyyy
if it is same date format as mine then I would have following conclusion: The data you have in the file is probably dumped from a certain location or computer as you have 2 dates in this file date in rm and pm that have the time are correct but the problem lies with the date that is in col F for rm and G for PM and in the Output sheets the column J Exp that need formating I suspect this column's value comes from a computer that has d/M/yyyy format and as it is not formated as real date it is beeing mis interpreted by the macro. I need confirmation on this.
As far as the code is concerned I am lost with your zillion posting of codes I will work with hte last version you posted prior to this one. Please STOP changing the code whileI am working as then fear cannot assist you further.
gowflow
ASKER
I did some checking and the default short date format for Windows 7 appears to be M/d/yyyy which is what mine is showing too. I have attached a screenshot. Rest assured that nothing will change in the code until it is updated by you, and then only the comments once we have resolved something. I knew the date thing was going to be a tough nut to crack which is why I had put it on hold till that other issue with the rows was resolved successfully. I greatly appreciate your help and apologize for confusing the question.
Screenshot-Short-Date-Format.png
Screenshot-Short-Date-Format.png
ASKER
PS. Note that original exports (PM and RM) are from this same computer but do have slightly different formats or so I have been told.
ok fine for the date here are my comments:
1) download the full code below and delete all the previous code you have as this will fix the opening workbook error what I did is in the sorting procedure I removed the (useless on error resume next poor programing) and noticed that the Sort key adding was misplaced and it was put in the loop where it need to only be put once outside the loop as I did here so it was creating an inside VBA error and as you had the expression on error resume next the code was continuing without giving you any sign and by saving the file it was flagging it that the sort key build is full this is why we were getting this weired error. So that's for that
2) Now to go back to your original quesiton that is the format of the Exp date my conclusion is the following: The macro that is building this date is wrong and it is building it in a way that when you look at the dates in either rm sheet or pm sheet you will automatically notice that I presume that this date is the date that you or the macro preformed the Export of the data look at the list and you will see that the date follows as month Oct-11 Nov-11 Dec 11 where in fact the dates written in the system are 10/11/2011 11/11/2011 12/11/2011 and they should be day 10 of November day 11 day 12 etc .... and when it hit 13 your are getting the wrong date format creating all this trouble around the date.
MY SUGGESTION
==============
2 ways to go about it
FIRST WAY
You go back to the routine that produce this date and ask it to be m/d/yyyy and this would solve all your trouble.
SECOND WAY
I presume first way is too good to be true and you will not be able to ge tthis done so we need to fix it ourselves. I propose a routine that I can build for you that you will activate ONCE !!! repeat ONCE each time you get a new set of data it will go and fix the dates in both rm and pm to be M/d/yyyy permutating the day with the month for all cells in bith sheet this way the data will come up corect in both output sheets naturally.
Your decision
gowflow
1) download the full code below and delete all the previous code you have as this will fix the opening workbook error what I did is in the sorting procedure I removed the (useless on error resume next poor programing) and noticed that the Sort key adding was misplaced and it was put in the loop where it need to only be put once outside the loop as I did here so it was creating an inside VBA error and as you had the expression on error resume next the code was continuing without giving you any sign and by saving the file it was flagging it that the sort key build is full this is why we were getting this weired error. So that's for that
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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 = True
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
'--> Unsure of what this section does?'
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
FixDate
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
ActiveSheet.PageSetup.PrintArea = ""
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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 wsopt.Range("B" & I) <> wsopt.Range("B" & I - 1) And wsopt.Range("B" & I) <> "" Then
wsopt.Rows(I & Chr(58) & I).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
wsopt.Sort.SortFields.Add Key:=wsopt.Range("C11"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
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
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.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
Private Sub FixDate()
'This Sub will go thru Exp Column Col J and will Fix the date to allow for either mm-yy or mmm-dd-yy.
Dim MaxRow As Long, I As Long
Dim tmpM As String, tmpD As String, tmpY As String
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
For I = 12 To MaxRow
'---> Strip Dates and Fix them
If wsopt.Cells(I, "J") <> "" Then
If IsDate(wsopt.Cells(I, "J")) Then
'---> Format normally if normal Date format as 'mmm-dd-yy'
wsopt.Cells(I, "J").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "J") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "J").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
2) Now to go back to your original quesiton that is the format of the Exp date my conclusion is the following: The macro that is building this date is wrong and it is building it in a way that when you look at the dates in either rm sheet or pm sheet you will automatically notice that I presume that this date is the date that you or the macro preformed the Export of the data look at the list and you will see that the date follows as month Oct-11 Nov-11 Dec 11 where in fact the dates written in the system are 10/11/2011 11/11/2011 12/11/2011 and they should be day 10 of November day 11 day 12 etc .... and when it hit 13 your are getting the wrong date format creating all this trouble around the date.
MY SUGGESTION
==============
2 ways to go about it
FIRST WAY
You go back to the routine that produce this date and ask it to be m/d/yyyy and this would solve all your trouble.
SECOND WAY
I presume first way is too good to be true and you will not be able to ge tthis done so we need to fix it ourselves. I propose a routine that I can build for you that you will activate ONCE !!! repeat ONCE each time you get a new set of data it will go and fix the dates in both rm and pm to be M/d/yyyy permutating the day with the month for all cells in bith sheet this way the data will come up corect in both output sheets naturally.
Your decision
gowflow
ASKER
gowflow,
Thank you sir. I greatly appreciate the bug fix for the close error that appears to have come about when the row fix was implemented. Great work there as well. I will try implementing the fix for the close error followed by the date solution from Michael74 here https://www.experts-exchange.com/questions/27477592/Show-date-only-when-it-is-listed-otherwise-month-and-year-only.html which just might work now. I'll have a look in the next couple days. Thank you again sir!
Thank you sir. I greatly appreciate the bug fix for the close error that appears to have come about when the row fix was implemented. Great work there as well. I will try implementing the fix for the close error followed by the date solution from Michael74 here https://www.experts-exchange.com/questions/27477592/Show-date-only-when-it-is-listed-otherwise-month-and-year-only.html which just might work now. I'll have a look in the next couple days. Thank you again sir!
the date solution offered by Michael will not fix your problem !!! you can try but I tell you this in advance your choice. we need to convert your date as it is not correct. You did not answer me on if the date that are shown in the file are correct look at the sheet rm and strat from where the items starts in row 3376 you will see this pattern in Col J both are from the Col J same row if you look at the values for me they are all in Nov Dec (dd/mm/yy) but the system is seeing them as Dec/Jan and further down it is Feb Mar etc...
12/11/11 11-Dec
12/11/11 11-Dec
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
12/11/11 11-Dec
12/11/11 11-Dec
12/11/11 11-Dec
12/11/11 11-Dec
12/11/11 11-Dec
12/11/11 11-Dec
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
what make me come to this conclusion is that strangely all dates are Day 11 which is morelikely to be Month 11 which is Novemeber.
Anyway you know better your data if this is not convincing and you feel the data is correct as it is then ok
gowflow
12/11/11 11-Dec
12/11/11 11-Dec
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
12/11/11 11-Dec
12/11/11 11-Dec
12/11/11 11-Dec
12/11/11 11-Dec
12/11/11 11-Dec
12/11/11 11-Dec
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
01/12/11 12-Jan
what make me come to this conclusion is that strangely all dates are Day 11 which is morelikely to be Month 11 which is Novemeber.
Anyway you know better your data if this is not convincing and you feel the data is correct as it is then ok
gowflow
ASKER
goflow,
I am having some difficulty understanding you which is why I have opted to at least give his solution a try. I'm holding out for you though. Thank you for the bug fix by the way, it works a charm.
The original data is exported as a .csv file. It is that .csv file that makes up the pm and rm tabs respective to whether the export is from a pm or rm account. Of 'course, I cannot change the way the originating .csv file is created. It is what it is. While I agree with your premise, I don't see a solution that works yet.
In reference to your question, I have not yet clearly understood what it was. Here is a video though http://screencast.com/t/qFlBwlbxsSlH so that you can see what I am seeing.
Again, thank you for your assistance.
I am having some difficulty understanding you which is why I have opted to at least give his solution a try. I'm holding out for you though. Thank you for the bug fix by the way, it works a charm.
The original data is exported as a .csv file. It is that .csv file that makes up the pm and rm tabs respective to whether the export is from a pm or rm account. Of 'course, I cannot change the way the originating .csv file is created. It is what it is. While I agree with your premise, I don't see a solution that works yet.
In reference to your question, I have not yet clearly understood what it was. Here is a video though http://screencast.com/t/qFlBwlbxsSlH so that you can see what I am seeing.
Again, thank you for your assistance.
ASKER
Michael's solution pasted below appears to do something but I do not have it correctly implemented. I am holding out for a better option though if you find one.
Sub fixDate(dte As Range)
Dim firstSpace As Long, dayLength As Long
firstSpace = InStr(dte.Value, " ")
If firstSpace <> 0 Then
If firstSpace = 5 Then
dayLength = 1
Else
dayLength = 2
End If
dte.NumberFormat = "MMM dd, yy"
dte.Value = CDate(Left(dte.Value, 3) & " " & Right("0" & Mid(dte.Value, 4, dayLength), 2) & ", " & Right(dte.Value, 2))
Else
dte.NumberFormat = "MMM, yy"
End If
End Sub
Sub processDates()
Dim firstRow As Long, i As Long
Dim dateCol As String
firstRow = 12
dateCol = "J"
For i = firstRow To Range(dateCol & Rows.Count).End(xlUp).Row
If Range(dateCol & i).Value <> "" Then Call fixDate(Range(dateCol & i))
Next
End Sub
could you post the csv file much easier to understand the problem ?
gowflow
gowflow
ASKER
ASKER
Note that all I did with the one you previously had was open it in Excel and save as xlsm so that I could attach the macro.
well haven't looked at the csv but will do now. Meantime I beleive this is your solution. Delete all the present code and here is a complete new code to paste in a copy of your workbook.
What I have done is corrected the dates you have in Col J from dd/mm/yyyy to mm/dd/yyyy with the formating you requested. I am now updating (for a trial we can change this when all is ok) Col P that is not used so you can compare Col J with New Col P
So run the macro for both sheets and check the output and let me know.
gowflow
What I have done is corrected the dates you have in Col J from dd/mm/yyyy to mm/dd/yyyy with the formating you requested. I am now updating (for a trial we can change this when all is ok) Col P that is not used so you can compare Col J with New Col P
So run the macro for both sheets and check the output and 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 = True
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
'--> Unsure of what this section does?'
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
ConvertDates
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
ASKER
What it looks like you did was remove everything above NewUpdates and eliminated NewUpdates from being called. That's part of my code and I have to have it. I can't test without it because my familiarity is not as good as yours. All the code must be there for me to be able to test your solution.
ASKER
I've tried copying in just what you fixed and it doesn't like ProcessDates for some reason. It would be better if the 'entire code' were pasted below. That way we are comparing apples to apples.
ASKER
I think I see where I was confused now. I have run the complete code pasted below with the 'save bug fix' and the 'Exp date column' implementation. I have received the error pictured.
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 = True
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
'--> Unsure of what this section does?'
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
ConvertDates
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
ActiveSheet.PageSetup.PrintArea = ""
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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 wsopt.Range("B" & I) <> wsopt.Range("B" & I - 1) And wsopt.Range("B" & I) <> "" Then
wsopt.Rows(I & Chr(58) & I).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
wsopt.Sort.SortFields.Add Key:=wsopt.Range("C11"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
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
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.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
Well don;t know why seems in my copy paste I meed on thhe sub CreateDates here it is just add it in module1
Sorry for that.
gowflow
Sorry for that.
gowflow
Private Sub ConvertDates()
Dim MaxRow As Long, I As Long, J As Long
Dim tmpM As String, tmpD As String, tmpY As String
Dim TmpDate, TmpFullDate
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
'We are assuming here that all dates are wrongly interpreted which need fixing in Col J
'Now the are interpreted as MM/DD/YYYY while the data in there is of type DD/MM/YYYY
'Which need to be converted so that data is meaningful
For I = 12 To MaxRow
If wsopt.Cells(I, "J") <> "" And wsopt.Cells(I, "J").Font.ColorIndex = 1 Then
If InStr(1, wsopt.Cells(I, "J"), "/") <> 0 Then
TmpDate = Split(wsopt.Cells(I, "J"), "/")
TmpFullDate = ""
TmpFullDate = TmpDate(1) & "/" & TmpDate(0) & "/" & TmpDate(2)
wsopt.Cells(I, "P") = TmpFullDate
wsopt.Cells(I, "P").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "P") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "P").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
ASKER
Run-time error 424 occurred.
Please just post the ENTIRE code to avoid confusion.
Please just post the ENTIRE code to avoid confusion.
ok
gowflow
gowflow
Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output with the data from the Trade History section of the original tab. It also takes'
'the notes from the Order History section of the original tab and then indexes and sorts each'
'Spread into meaningful positions.'
'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
Private Sub ConvertDates()
Dim MaxRow As Long, I As Long, J As Long
Dim tmpM As String, tmpD As String, tmpY As String
Dim TmpDate, TmpFullDate
MaxRow = wsopt.Rows(wsopt.Rows.Count).End(xlUp).Row
'We are assuming here that all dates are wrongly interpreted which need fixing in Col J
'Now the are interpreted as MM/DD/YYYY while the data in there is of type DD/MM/YYYY
'Which need to be converted so that data is meaningful
For I = 12 To MaxRow
If wsopt.Cells(I, "J") <> "" And wsopt.Cells(I, "J").Font.ColorIndex = 1 Then
If InStr(1, wsopt.Cells(I, "J"), "/") <> 0 Then
TmpDate = Split(wsopt.Cells(I, "J"), "/")
TmpFullDate = ""
TmpFullDate = TmpDate(1) & "/" & TmpDate(0) & "/" & TmpDate(2)
wsopt.Cells(I, "P") = TmpFullDate
wsopt.Cells(I, "P").NumberFormat = "Mmm-dd-yy"
Else
'---> Strip the date in Day month Year then re-group so system would recognize
' it as a date and then apply format 'mmm-yy'
tmpM = Left(wsopt.Cells(I, "J"), 3)
tmpY = Right(wsopt.Cells(I, "J"), 2)
tmpD = Mid(wsopt.Cells(I, "J"), 4, Len(wsopt.Cells(I, "J")) - 6)
wsopt.Cells(I, "P") = tmpM & " " & Format(Val(tmpD), "") & ", " & Format(Val(tmpY), "")
wsopt.Cells(I, "P").NumberFormat = "Mmm-yy"
End If
End If
Next I
End Sub
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 = True
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
'--> Unsure of what this section does?'
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
ConvertDates
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
ActiveSheet.PageSetup.PrintArea = ""
wsopt.PageSetup.FitToPagesWide = 1
wsopt.PageSetup.FitToPagesTall = 1
End Sub
'DEFINITIONS - Definitions to understand prior to Indexing and Ordering'
'1. Positions - Positions can be made up of more than one Spread and the newest Positions appear at the top of the sheet.'
'2. Spreads - Spreads can be made up of more than one Leg and their order with a position can change.'
'3. Legs - Legs are made up of individual rows within a Spread and there order within the spread never changes.'
Private Sub Indexing()
'Each Position, Spread, and Leg is indexed with a number according to the value in its Exec Date column.'
'P# - Positions are numbered sequentially with 1 being meaning that it contains a newer Exec Date than any other positions.'
'S# - Spreads are numbered sequentially with 1 meaning that it contains the a newer Exec Date than the other spreads.'
'L# - Legs are numbered sequentially with 1 containing the oldest Exec Date within it's particular spread and starting over at the next spread.'
'If the Exec Date column (which is actually a date and time stamp) contains the same values, then the Symbol is used in alphabetical order.'
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()
'Positions can contain single or multi-legged spreads but the sort order of the legs 'within' each'
'spread never changes. This is an important point because by contrast, the sort order in which each
'spread appears within the overall position does indeed change. Here the oldest spreads should'
'appear at the top of the position while newer spreads should appear at the bottom of the position.'
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 wsopt.Range("B" & I) <> wsopt.Range("B" & I - 1) And wsopt.Range("B" & I) <> "" Then
wsopt.Rows(I & Chr(58) & I).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'--> Added by gowflow to keep correct counting of last row
Rcount = Rcount + 1
End If
Next I
'--> Sorting the output by Date descending
Brow = 0
'--> Changed by gowflow from upper Rcount to Rcount +1
wsopt.Sort.SortFields.Add Key:=wsopt.Range("C11"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
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
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.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
ASKER
goflow thank you,
While your code runs and does not error, it does not create the desired output which in the screenshot here >> http://screencast.com/t/YCUGKyUT0t would be Dec-2-11 and Dec-11 respectively.
I also notice that the subroutines are not in logical order. It is critical that the original sheet not change at all and the new Output is in the Output tab by design. The logical order of subroutines in module1 as I understand their purpose might be as follows:
1. TradeReport - This copies over the Trade History to the new Output tab without changing anything in the original data.
2. NewUpdates - This imports the notes from the filled items in the Order History to the new Output tab.
3. ConvertDates - This converts the Exp date column to read mmm-dd-yy or mmm-yy as required.
4. Indexing - This indexes the Output tab so that each Position with a P#, each Spread with a S#, and each Leg with a Leg#
5. Sorting - This sorts the Output tab so that the Spreads that potentially contain multiple legs, are moved into positions in the proper sequence.
It seems logical to me that the macro in Module1 would remain ordered in that way. What am I missing?
While your code runs and does not error, it does not create the desired output which in the screenshot here >> http://screencast.com/t/YCUGKyUT0t would be Dec-2-11 and Dec-11 respectively.
I also notice that the subroutines are not in logical order. It is critical that the original sheet not change at all and the new Output is in the Output tab by design. The logical order of subroutines in module1 as I understand their purpose might be as follows:
1. TradeReport - This copies over the Trade History to the new Output tab without changing anything in the original data.
2. NewUpdates - This imports the notes from the filled items in the Order History to the new Output tab.
3. ConvertDates - This converts the Exp date column to read mmm-dd-yy or mmm-yy as required.
4. Indexing - This indexes the Output tab so that each Position with a P#, each Spread with a S#, and each Leg with a Leg#
5. Sorting - This sorts the Output tab so that the Spreads that potentially contain multiple legs, are moved into positions in the proper sequence.
It seems logical to me that the macro in Module1 would remain ordered in that way. What am I missing?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Now that looks like it might be a close to a winner. Thank you. The only problem I have with that is that we are assuming the 11th which is incorrect as illustrated here >> http://screencast.com/t/oCaXlLIAuy.
The fact that there is only a month and a year indicates that they are monthly options instead of weekly or quarterly, but the 11th is incorrect for monthly options.
The fact that there is only a month and a year indicates that they are monthly options instead of weekly or quarterly, but the 11th is incorrect for monthly options.
Well sorry but that is the date that you have in the original file I did not change it !!! what do you mean by monthly you want to convert all the date to first of the month ????
gowflow
gowflow
ASKER
goflow,
It all appears correct in the column.
mmm-dd-yy for weekly and quarterly options.
mmm-yy for traditional monthly options.
The appearance of them is correct and should not change. What isn't right is the way the date looks in the formula row http://screencast.com/t/oCaXlLIAuy because it takes on a specific date.
In actuality, they do have a specific date based on some complex criteria but it is not necessary that it be shown. Since they are considered monthly options (the most common), the only the month and the year need to be used for those.
Again, they show up correctly within the columns themselves so that part has been resolved.
It all appears correct in the column.
mmm-dd-yy for weekly and quarterly options.
mmm-yy for traditional monthly options.
The appearance of them is correct and should not change. What isn't right is the way the date looks in the formula row http://screencast.com/t/oCaXlLIAuy because it takes on a specific date.
In actuality, they do have a specific date based on some complex criteria but it is not necessary that it be shown. Since they are considered monthly options (the most common), the only the month and the year need to be used for those.
Again, they show up correctly within the columns themselves so that part has been resolved.
Well well well !!!!
You need to understand 1 thing
The appearence means nothign to excel or I should say we can play with the appearence called formating as long as the inside is a date ! date is represented by excel into a number called serial number each date from 1900 till 2099 has a unique serial number and if the date entered in excel follows the recognized pattern it conver it to a serial number and automatically formated the way you saw it 12/11/2011. Now the formating that you see in the cell is the way you want to see this cell you choose to 'sometimes' see it mmm-dd-yy and some other times see it mmm-yy and that is fine and the date is still a date !
What you are asking now is to keep the mmm-dd-yy as dates and now convert or change the inside of the mmm-yy to be strictly a text APR-11 or Dec-11 so they look on the inside like the outside.
We can do this but you have to be very careful coz when we change the date inside to a text it is no more a date and will not be recognized by excel for future manipulations !!!
Your choice.
gowflow
You need to understand 1 thing
The appearence means nothign to excel or I should say we can play with the appearence called formating as long as the inside is a date ! date is represented by excel into a number called serial number each date from 1900 till 2099 has a unique serial number and if the date entered in excel follows the recognized pattern it conver it to a serial number and automatically formated the way you saw it 12/11/2011. Now the formating that you see in the cell is the way you want to see this cell you choose to 'sometimes' see it mmm-dd-yy and some other times see it mmm-yy and that is fine and the date is still a date !
What you are asking now is to keep the mmm-dd-yy as dates and now convert or change the inside of the mmm-yy to be strictly a text APR-11 or Dec-11 so they look on the inside like the outside.
We can do this but you have to be very careful coz when we change the date inside to a text it is no more a date and will not be recognized by excel for future manipulations !!!
Your choice.
gowflow
ASKER
I'll request to open thread up for discussion. Thank you!
Ok tks for the grade but you could hv answered here I don't have a problem when open an other question ?
gowflow
gowflow
ASKER
I need to think about it. I definitely need it to BE a date. Future development will require calculating the days to Expiration in it's own which will use the Exp date and the Exec Time columns to come up with that value. The trouble is that we need a way to distinguish between monthly, quarterly, and monthly options. Currently, an experienced trader can do that by looking. However, if we put a mmm-dd-yy for ever one, this will no longer be the case. A column next to it that had a W for Weekly, M for Monthly, and Q for Quarterly would do the trick but then defining that becomes difficult. It's 5am now so there isn't any way I can think through that now and it may take several days for me to formulate some criteria for a new question.
Monthly options use the Third Thursday of each month excluding holidays.
Quarterly and Weekly options play by different rules.
Thank you for all your help!!
Monthly options use the Third Thursday of each month excluding holidays.
Quarterly and Weekly options play by different rules.
Thank you for all your help!!
I have hte solution for you we create a new column and will put text there ask a realted question and I will be gald to help.
gowlfow
gowlfow
when normal date it will show as you requested mmm-dd-yy and when its not a date it will be converted to a normal date but will format it as you requested mmm-yy so that the whole data in the column will be a date type
Is it ok this way ?
gowflow