Sort Data based on date

Hi Experts,

I would like to request Experts help create a macro to delete all prefix stars with “pcdn-tr/” at Column C and sort the data ascendant (A to Z) with condition the priority given to the nearest start date (Column H). Some header (Column C) has multiple start date at column C, for that type of data the first date become a point of reference (the multiple start date need to be maintained with the Header (Column C). Hope Experts will help me to create this feature.



FilterData.xls
CartilloAsked:
Who is Participating?
 
StephenJRConnect With a Mentor Commented:
OK, try this:
Sub SortData()

Dim i As Long, n As Long, r As Range

On Error Resume Next
Range("H7", Range("H" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

n = Range("H" & Rows.Count).End(xlUp).Row

For Each r In Range("C7").Resize(n).SpecialCells(xlCellTypeConstants)
    r = Trim(Split(r, "/")(1))
Next r

For i = 1 To 3
    With Range("A7:G" & n).Columns(i)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
Next i

With Range("A7:I" & n)
    .Sort key1:=.Cells(1, 8), order1:=xlAscending, Header:=xlYes
End With

End Sub

Open in new window

0
 
StephenJRCommented:
Cartillo - if I were going to do this, I would remove the blank rows, and replicate the column C entry for each column H entry. Is that acceptable?
0
 
CartilloAuthor Commented:
StephenJR,

Instead of copying column H data, is that possible copy column C data. E.g. at row 45 we have "Euro: Euro's Monarchies - generic :15 - Tomorrow 10/9pm". We can copy this data at row 46 to 48. We can use the same "Header" for blank row at Column C as long as the row has Start Date.
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
StephenJRCommented:
Cartillo - if I have understood correctly, try this:
Sub x()

Dim i As Long, n As Long

On Error Resume Next
Columns("H:H").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

n = Range("H" & Rows.Count).End(xlUp).Row

Range("C2").Resize(n).Replace what:="pcdn-tr/ ", replacement:=""

For i = 1 To 3
    With Range("A1:C" & n).Columns(i)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
Next i

With Range("A1:I" & n)
    .Sort key1:=.Cells(1, 8), order1:=xlAscending, header:=xlYes
End With

End Sub

Open in new window

0
 
CartilloAuthor Commented:
Hi StephenJR,

I need your help. After test with the actual data I realize that we need to copy data from A to G if the data at column C "Header" has multiple "Start Date". Hope you can help me to add this function.
0
 
CartilloAuthor Commented:
Hi StephenJR,

Managed to solve above issue by modifying this line,
 
With Range("A1:C" & n).Columns(i)

but I'm not sure how to add an additional "prefix" for deletion. How to add this prefix for deletion ""pcdn-trQ/ " besides "pcdn-tr/ " at this line:

Range("C2").Resize(n).Replace what:="pcdn-tr/ ", replacement:=""

Hope you can assist

0
 
StephenJRCommented:
Cartillo,

You could add this line, before the other replace line:

Range("C2").Resize(n).Replace what:="pcdn-trQ/ ", replacement:=""
0
 
CartilloAuthor Commented:
Hi StephenJR,

I have tried but both prefix are still exist.
0
 
StephenJRCommented:
Cartillo - when I tried it on the sample with the first replacement, that worked.
0
 
CartilloAuthor Commented:
Hi StephenJR,

I made some changes at the row ( I need to reserve first few rows), dose this has any impact with the prefix deletion?  Attached the code for your perusal. I could make a blunder in this code.
Sub SortData()

Dim i As Long, n As Long

On Error Resume Next
Columns("H7:H").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

n = Range("H" & Rows.Count).End(xlUp).Row

Range("C7").Resize(n).Replace what:="pcdn-trQ/ ", replacement:=""
Range("C7").Resize(n).Replace what:="pcdn-tr/", replacement:=""



For i = 1 To 3
    With Range("A7:G" & n).Columns(i)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
Next i

With Range("A7:I" & n)
    .Sort key1:=.Cells(1, 8), order1:=xlAscending, Header:=xlYes
End With

End Sub

Open in new window

0
 
StephenJRCommented:
What about this?
Sub SortData()

Dim i As Long, n As Long

On Error Resume Next
Range("H7", Range("H" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

n = Range("H" & Rows.Count).End(xlUp).Row

Range("C7").Resize(n).Replace what:="pcdn-trQ/ ", replacement:=""
Range("C7").Resize(n).Replace what:="pcdn-tr/", replacement:=""

For i = 1 To 3
    With Range("A7:G" & n).Columns(i)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With
Next i

With Range("A7:I" & n)
    .Sort key1:=.Cells(1, 8), order1:=xlAscending, Header:=xlYes
End With

End Sub

Open in new window

0
 
CartilloAuthor Commented:
Hi StephenJR,

Now the data are line up perfectly, but both prefix still exist.  
0
 
StephenJRCommented:
Not for me. A few of these "thcn-prx/" are still there but the others disappear. Would it be easier to remove anything before (and including) "/" or could you have "/" elsewhere?
0
 
CartilloAuthor Commented:
Hi StephenJR,

Removing remove anything before (and including) "/" would be the best option. Hope you help me to create this.
0
 
CartilloAuthor Commented:
Cool! Thanks a lot for the great help
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.

All Courses

From novice to tech pro — start learning today.