Solved: Convert time entered on row to ascending dates

[RonNCmale]

I'm trying to enter time on row 11 of any of the worksheets and have the date of the entered time to be listed in ascending order on the worksheet labeled "sheet1". I entered an example of what I would like it to do on the attached workbook. Any help would be appreciated Thanks

[mbarron]

Put the following in the ThisWorkbook module

[vba]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rngTo As Range
If Sh.Index = 1 Then Exit Sub
If Not Intersect(Target, Sh.Range("C11:J11")) Is Nothing And Target.Count = 1 Then
Application.EnableEvents = False
Target.Offset(-6).Copy
Set rngTo = Sheets(1).Cells(Rows.Count, 4).End(xlUp).Offset(1)
With rngTo
.PasteSpecial xlPasteValues
.NumberFormat = "m/dd/yyyy"
End With
Sheets(1).Cells(4, 4).Sort key1:=Sheets(1).Cells(4, 4), Order1:=xlAscending, header:=xlYes
Application.EnableEvents = True
End If
End Sub[/vba]

[RonNCmale]

I tried the code mbarron but it did not work, did you apply this code to timereport.xls and it worked? If so please upload. If not do you or anyone else have any suggestions.

[p45cal]

mbarron's code needs to be pasted in the Thisworkbook code module. It might also be worth executing:
Application.EnableEvents = True
in the Immediate pane.

The only niggle with it is that if someone alters an existing value in one of the sheets, the date will appear twice (or more) in Sheet1.

I've attached a file where the list of holidays on sheet1 is deleted then completely reconstituted each time a change is made on any of the sheets in the relevant cells.
It consists of this in the Thisworkbook code module:
[vba]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Sh.Range("C11:J11")) Is Nothing Then
blah
End If
End Sub
[/vba]and this in a standard code module:
[vba]Sub blah()
On Error GoTo ErrHandler
Application.EnableEvents = False
Dim Hols() As Date
i = 0
For Each sht In ThisWorkbook.Worksheets
If sht.Name <> "Sheet1" Then
For Each cll In sht.Range("$C$11:$I$11")
If Not IsEmpty(cll) Then
i = i + 1
ReDim Preserve Hols(1 To i)
Hols(i) = cll.Offset(-6).Value
AtLeast1Date = True
End If
Next cll
End If
Next sht
With ThisWorkbook.Sheets("Sheet1")
Range(.Range("D4"), .Range("D4").End(xlDown)).ClearContents
If AtLeast1Date Then
i = 1
For Each dte In Hols
.Range("D3").Offset(i) = dte
i = i + 1
Next dte
.Cells(3, 4).Sort key1:=Sheets(1).Cells(3, 4), Order1:=xlAscending, Header:=xlYes
End If
End With
ErrHandler:
Application.EnableEvents = True
End Sub
[/vba]

[RonNCmale]

Thanks P45cal, It does exactly what I was wanting it to do. My life will be a little easier now. Thanks again.

[p45cal]

deleted (wrong thread!)

[Aussiebear]

deleted (wrong thread!)

Hmmm....six pack please! Aussie beer, none of that foriegn stuff.