• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 385
  • Last Modified:

Show date only when it is listed, otherwise month and year only.

The attached sheet is originally exported as a CSV file for processing. Before saving it as a XLSX, I need to format the Exp date column so that it shows the month (mmm) followed by the year (yy). The trouble is that sometimes a specific day will exist and sometimes it will not.  When it does show a day, then it should be represented as mmm dd, yy and when a day is not available (which is most of the time), it should just be represented as mmm yy. I am trying to do this within a single formula itself and not as part of a macro. Assistance is greatly appreciated.
temp.csv
0
rtod2
Asked:
rtod2
  • 12
  • 6
  • 5
  • +1
2 Solutions
 
Michael FowlerSolutions ConsultantCommented:
Here is a function that will convert the date as required.

Michael
Function fixDate(dte As String) As String
   Dim firstSpace As Long, dayLength As Long
     
   fixDate = Format(dte, "MMM, yy")
   
   firstSpace = InStr(dte, " ")
   
   If firstSpace <> 0 Then
      If firstSpace = 5 Then
         dayLength = 1
      Else
         dayLength = 2
      End If
   
      fixDate = Left(dte, 3) & " " & Right("0" & Mid(dte, 4, dayLength), 2) & ", " & Right(dte, 2)
   End If
End Function

Open in new window

0
 
rtod2Author Commented:
Michael, thank you.
I am trying to do it as part of the format string so that I don't have to run a macro to accomplish it.
0
 
gowflowCommented:
Hi rtod2
If the date you need to verify is in A1 put htis formula in B1 and it will format it depending on what is in A1
=IF(ISERROR(FIND("/",A1,1)<>0),TEXT(A1,"mmm dd, yy"),TEXT(A1,"mmm yy"))

I attached this file for your refrence
gowflow
temp.csv
0
Ultimate Tool Kit for Technology Solution Provider

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

 
gowflowCommented:
oops correction
If the date you need to verify is in B2 put htis formula in A2 and it will format it depending on what is in B2
=IF(ISERROR(FIND("/",B2,1)<>0),TEXT(B2,"mmm dd, yy"),TEXT(B2,"mmm yy"))

The file had the correct refrences its only the text here I did not change
gowflow

0
 
rtod2Author Commented:
The Exp date column has nothing to do with any other column.  It is a unique value and should stand on it's own. My question is about how to format the date shown here http://screencast.com/t/sOavh1wxI. The column G stands on it's own and is not part of any other column.
0
 
Michael FowlerSolutions ConsultantCommented:
You could always expand the macro to import the correct csv file, perform the formatting and save this file.

Michael
0
 
rtod2Author Commented:
Michael, Thank you!

I need a one-liner though that will put the correct format http://screencast.com/t/sOavh1wxI.
0
 
Michael FowlerSolutions ConsultantCommented:
As far as I am aware you cannot format a cell so it will display a different date format based on the data in the cell.

To get the result you want you will need to run a macro to import the data and format it before inputting it in the cell or use the formula supplied by goflow, and then use copy-paste special-values to move the adjusted values to the correct location

Michael
0
 
gowflowCommented:
Sorry did not login ystday seeing the threads here I hv this comment.
rtod2
You mean to say you do not want a formula you simply want a Format that will either give you
"mmm dd, yy" if normal date or
"mmm yy" if not normal date in Col G is that what you are after ???

If above is correct then as Micheal74 pointed out sorry a formating of a cell cannot (to my humble knowledge) test data to see if normal date or not ! you need to either apply formula like I provided you with earlier or a macro as Micheal74 pointed out.

Your choice ! If you keep on insisting that it can be done in formating ... then I will gladly wait to see this solution !
gowflow
0
 
Rob HensonFinance AnalystCommented:
If the contents of the cell are one of two options:

1) dd/mm/yy
2) mmm yy

Excel will recognise 1) as a date and format it accordingly

Excel will recognise 2) as text and leave it as it is.

Therefore, apply the required date formatting to the whole column and those entries that are true dates will be formatted as required and the dates with only month and year will stay as text.

Thanks
Rob H
0
 
rtod2Author Commented:
Michael,
Your solution appears to be the only one that comes close and if a one-liner isn't available then that's the option I am trying to incorporated. However, I can't get it to run and have attached the new sheet for your review. Further assistance is greatly appreciated. The code we are talking about now is pasted below and the objective is the same as it was in the first post.
Function fixDate(dte As String) As String
   Dim firstSpace As Long, dayLength As Long
     
   fixDate = Format(dte, "MMM, yy")
   
   firstSpace = InStr(dte, " ")
   
   If firstSpace <> 0 Then
      If firstSpace = 5 Then
         dayLength = 1
      Else
         dayLength = 2
      End If
   
      fixDate = Left(dte, 3) & " " & Right("0" & Mid(dte, 4, dayLength), 2) & ", " & Right(dte, 2)
   End If
End Function

Open in new window

0
 
Michael FowlerSolutions ConsultantCommented:
@rtod2

When I test the macro with my data it is working. Could you please advise what is happening and if possible post an example workbook with data so I can test further

Michael
0
 
Rob HensonFinance AnalystCommented:
Have you tried my suggestion with just applying formatting to the whole column or at least the cells containing the data.

With the small sample that you uploaded applying a custom format of "mmm dd, yy" changed only those cells that were recognised as dates. Those that were not recognised because they only have "mmm yy" were left alone and stay as text.

Is this not what you want?

Thanks
Rob H
0
 
rtod2Author Commented:
Rob, all need to be date format which is what Michael is proposing I think.  I have attached a sheet with his macro to see if he can troubleshoot.

Michael, thank you.
I must assume that you were talking about placing this inside of an already existing macro.  I have attached the sheet but cannot get the macro into it.
Date-Test.xlsm
0
 
Rob HensonFinance AnalystCommented:
But a string of text, eg "Apr 11", cannot be formatted as a date. It will only be recognised as text. To be a date it will have to have a day element to it as well.

If you have a date entry of 01/04/11 (first day of April to avoid any cross country interpretations) it can be formatted so it appears as "Apr 11" using format "mmm yy" but Excel will still recognise as a date and will be able to do calculations with it.

Type in "Apr 11" manually and excel will automatically add a day element and will assume first of the month. Paste or import a block of text and excel will not do the same, the text import wizard does not allow for partial dates, only complete dates in various formats.

If you are saying that for those entries where there is no day element you want to add a day element, that is not what has been asked for so far, that would no doubt be possible with VBA depending on the text entries being within certain parameters with abbreviations, eg for June do you want it to recognise Jun or June, for September - Sep or Sept etc. There aren't that many (known) variations so it would be possible to cover most of them.

0
 
Rob HensonFinance AnalystCommented:
Looking again at your original CSV, I think I see clearer; apologies for the little rant above!!

Some entries have "mmmd yy" and not just "mmm yy" and are therefore complete dates but not in a format that is recognised.

For example the two unrecognised dates in the CSV are Apr1 11 which I take it are 1st April 2011.

0
 
Rob HensonFinance AnalystCommented:
OK, a couple more options for you:

Option 1 for extracting day from date with mmmd and converting to date format:

Formula =IF(ISNUMBER(G2),G2,VALUE(MID(G2,4,2)&LEFT(G2,3)&" "&RIGHT(G2,2)))

This checks if value in G is a number (dates are) and if so uses it otherwise re-arranges the contents to a text string "d mmm yy" which is then recognised by the value function to convert to a number to be formatted as a date.

Option 2 ignoring day element and giving text string of "mmm yy"
=IF(ISNUMBER(G2),G2,LEFT(G2,3)&" "&RIGHT(G2,2))

Put whichever formula you choose in a separate column for as many cells as required and then copy paste values over the original in column G.

Then apply custom format of "mmm dd, yy" to all entries in column G and those that are proper dates will be shown as dates and those that are text will not.

Apply a custom format by selecting cells to apply to. Right click on one and choose Format Cells. Left hand pane "Category" choose Custom; right hand pane immediately below Type: enter "mmm dd, yy" (without the quotes).

If you are going down the text entry for unrecognsied dates, you may as well skip the formula, copy paste stages and just apply the custom format. There is little or no point in replacing one text value with another text value unless you want to lose the misplaced day element.

If you want to do this in a vba routine that looks at each cell and converts or just formats, that can be achieved but not tonight!!

Thanks
Rob H

0
 
Michael FowlerSolutions ConsultantCommented:
The attached file has the macro ready to run. It will loop through all data in column J starting at row 12 and fix the dates. Since the file you uploaded did not have any data in the 2nd format sheet1 has the data from the original csv you posted

Michael
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

Open in new window

Copy-of-Date-Test.xlsm
0
 
rtod2Author Commented:
Michael thank you. I clearly think your solution is the best here.

The attached file is actual data. I didn't upload earlier because a developer was working on it and I didn't want to end up with changes I couldn't easily merge. So as you can see in the code below, there is a section designed to remove rows for "weekly's and quarterly's" based on a poorly formatted Exp column. Now that we don't have that issue anymore and have your handy code above designed to give me good output for that column, the question becomes how to implement your solution.

I would open up a new question but in the interest of clarity I thought it best to post the file containing my macro and see what happens.  Thank you for the assist.

Option Explicit
'--> This macro takes either pm or rm tabs and creates a properly formatted table in a new tab'
'called Output.'

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

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

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

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

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

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

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

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

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

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

End Sub

Private Sub Indexing()

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


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

For i = 12 To Rcount

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

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

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

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

Private Sub Sorting()

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

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


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

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

Open in new window

test-1.2d.xlsm
0
 
rtod2Author Commented:
Eliminate line 110-135 in favor of Michael's solution to the problem.
0
 
Michael FowlerSolutions ConsultantCommented:
Not quite that simple

I have added my code, removed lies 110-135 and added a call to processDates at the end of the TradeReports sub

I have attached the file with the changes made

Question - Two dates appear in column K with incorrect format. Do they need to change also

Michael
test-1.2d-1.xlsm
0
 
rtod2Author Commented:
Michael, thank you, I actually should have linked to the file rather than posting it. If you could, just post the code and not the actual file.

I'm not sure what you did but that messed up alot of values from how it would have processed without that change http://screencast.com/t/8fTbb9hBv. To be clear, we aren't talking about the Exec Time column or any other cells at all other than those in the Exp date column. You might try running a before and after to see what else changed besides the Exp column.

Example output for Exp column might be:

Denote Exp month for standard options:  Dec 11
Denote Exp date for a weekly or quarterly option: Dec 8, 11

If there are others, I haven't yet
0
 
rtod2Author Commented:
...seen them.

Thank you sir for your help.
0
 
gowflowCommented:
rtod2
I thought you were taken care of this is why I left the threads until I got a message from Moderator requesting help.

I see you posted below file in id ID: 37259015 and I recall in your original post you had values sometimes full date 1/2/2011 that you wanted formated as mmm dd, yy and if the day does not show then you wanted formated as mmm, yy

If my assumption (that's what I read from your intial post) are correct then I have following questions:
1) In the file you posted what is the column that you need to be fixed ? I see Col J but it has all correct dates so ... ???
2) Pls clarify exactly with the posted file what need to happen

I am willing to help you till you get a clear solution that satissfies you.
gowflow
Date-Test.xlsm
0
 
rtod2Author Commented:
Thank you both.  I have botched this question up pretty bad and am redirecting with a newly revised question.
0
 
rtod2Author Commented:
I have tabled the date formatting until I can get the code causing the issue out of the sheet. Please see re-direct here >> http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27487752.html

Thank you both for your help!!
0
 
rtod2Author Commented:
Michael, I would be grateful to you if you could have a look here http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27492518.html also. I have returned to this date issue as stated in the new thread. Thank you sir.
0
Question has a verified solution.

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

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 12
  • 6
  • 5
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now