Filter Data As per Date

[hashi2c]

Can someone help me?

I want the data (Vessel Name) will be filtered automatically as per cell Date (04-Dec-2017)

Data Sheet
Vessel Name	Arrival Date	Departure Date
Vessel-1	01-Dec-2017	04-Dec-2017
Vessel-2	01-Dec-2017	02-Dec-2017
Vessel-3	01-Dec-2017	04-Dec-2017
Vessel-4	01-Dec-2017	08-Dec-2017
Vessel-5	02-Dec-2017	03-Dec-2017
Vessel-6	02-Dec-2017	03-Dec-2017
Vessel-7	02-Dec-2017	05-Dec-2017
Vessel-8	02-Dec-2017	02-Dec-2017

Report Sheet
Available vessels on the Date of	04-Dec-2017
Vessel Name
Vessel-1
Vessel-3
Vessel-4
Vessel-7

Thank you in advance for all who helps and suggest.

 

[MickG]

Try this, Data in Sheet "Data Sheet" Results in Sheet "Report Sheet", when Date in "Report sheet " "B1" Changed.
NB:- The Header "Vessel Name" in sheet "Data Sheet" assumed to be in "A1"

Private [COLOR=navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=navy]As[/COLOR] Range)
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, Dt [COLOR=navy]As[/COLOR] Date, Ray()
[COLOR=navy]Dim[/COLOR] C [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
C = 3
Application.EnableEvents = False
    [COLOR=navy]If[/COLOR] Target.Address(0, 0) = "B1" [COLOR=navy]Then[/COLOR]
        [COLOR=navy]With[/COLOR] Sheets("Data Sheet")
            [COLOR=navy]Set[/COLOR] Rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
        [COLOR=navy]End[/COLOR] With
        Range("A4").Resize(Rng.Count).ClearContents
            [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
                [COLOR=navy]For[/COLOR] Dt = Dn To Dn.Offset(, 1)
                    [COLOR=navy]If[/COLOR] Dt = Target.Value [COLOR=navy]Then[/COLOR]
                        C = C + 1
                        Cells(C, 1) = Dn.Offset(, -1).Value
                    [COLOR=navy]End[/COLOR] If
                 [COLOR=navy]Next[/COLOR] Dt
            [COLOR=navy]Next[/COLOR] Dn
    [COLOR=navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

NB:- How to:-
To Save and Run Code:-
Copy code from Thread
In Your sheet "Report Sheet" Click "Alt + F11",:- Vb Window appears.
Paste Code into this window.
Close Vbwindow.
When you now change value in "B1" the code should run and Column "A" should be updated.

Regrds Mick



Regards Mick

 

[MickG]

Please post your reply back to this original Thread not a PM.
(1) Posting PM's to me only confuses the problem and breaks up the continuity of the Thread
(2) For some reason copying your data from the PM ,creates problems when pasting as the received data becomes garbled.
(3) NB:- You appear to have exceeded your Private message Quota.Please clear some messages !!!

 

[hashi2c]

Hi Mick,

Thank You so much for your help, it's working perfectly with date, but i need to get Time difference also in same report sheet. is that possible?

Data Sheet

Vessel Name	Arrival Date & Time	Departure Date & Time	Time Diff. (HRS)
Vessel-1	01-Dec-17 15:30	04-Dec-17 01:10	57:40
Vessel-2	01-Dec-17 16:00	02-Dec-17 15:00	23:00
Vessel-3	01-Dec-17 17:10	04-Dec-17 14:20	69:10
Vessel-4	01-Dec-17 17:30	08-Dec-17 02:00	152:30
Vessel-5	02-Dec-17 18:00	03-Dec-17 05:45	11:45
Vessel-6	02-Dec-17 18:45	03-Dec-17 06:00	11:15
Vessel-7	02-Dec-17 20:20	05-Dec-17 23:00	74:40
Vessel-8	02-Dec-17 21:00	02-Dec-17 21:50	0:50
Report Sheet
Date :	04-Dec-17
Available vessels on the Date of (B1)	Time Diff. (HRS)
Vessel-1	01:10
Vessel-3	14:20
Vessel-4	24:00
Vessel-7	24:00

<tbody>
</tbody>

 

[MickG]

Please explain the logic for Vessel-4 & Vessel_7 having a time difference of 24:00 ()hrs)

 

[hashi2c]

Vessel-4 & Vessel-7 available full day on 4th Dec 2017

 

[MickG]

Try this:-

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dt [COLOR="Navy"]As[/COLOR] Date, Ray(), Tm [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] C [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
C = 3
Application.EnableEvents = False
    [COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "B1" [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]With[/COLOR] Sheets("Data Sheet")
            [COLOR="Navy"]Set[/COLOR] Rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
        [COLOR="Navy"]End[/COLOR] With
        Range("A4").Resize(Rng.Count).ClearContents
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                [COLOR="Navy"]For[/COLOR] Dt = DateValue(Dn) To DateValue(Dn.Offset(, 1))
                    [COLOR="Navy"]If[/COLOR] DateValue(Dt) = Target.Value [COLOR="Navy"]Then[/COLOR]
                        C = C + 1
                        Cells(C, 1) = Dn.Offset(, -1).Value
                        Tm = IIf(DateValue(Dn.Offset(, 1)) - Target.Value = 0, Format(Dn.Offset(, 1) - Target.Value, "hh:mm"), "24:00:00")
                        Cells(C, 2).NumberFormat = "General"
                        Cells(C, 2) = Tm
                    [COLOR="Navy"]End[/COLOR] If
                 [COLOR="Navy"]Next[/COLOR] Dt
            [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[hashi2c]

Hi Mick,

Thanks for your quick response; it's very much appreciated,

If i put 02 Dec-17 need to get result as below, (I need know how many hours vessels consumed on selected date.

Date :	02-Dec-17
Available vessels on the Date of (B1)	Time Diff. (HRS)
Vessel-1	24:00
Vessel-2	15:00
Vessel-3	24:00
Vessel-4	24:00
Vessel-5	6:00
Vessel-6	5:15
Vessel-7	3:40
Vessel-8	0:50

<tbody>
</tbody>

 

[MickG]

Try this:-

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Dn As Range, Dt As Date, Ray(), Tm As String
Dim C As Long
C = 3
Application.EnableEvents = False
    If Target.Address(0, 0) = "B1" Then
        With Sheets("Data Sheet")
            Set Rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
        End With
        Range("A4").Resize(Rng.Count, 2).ClearContents
            For Each Dn In Rng
                For Dt = DateValue(Dn) To DateValue(Dn.Offset(, 1))
                    If DateValue(Dt) = Target.Value Then
                        C = C + 1
                        Cells(C, 1) = Dn.Offset(, -1).Value
                       
                        Select Case True
                                Case DateValue(Dn.Offset(, 1)) - Target.Value = 0 And DateValue(Dn.Offset(, 1)) = DateValue(Dn.Value): Tm = Format(Dn.Offset(, 1) - Dn.Value, "hh:mm")
                                Case DateValue(Dn.Offset(, 1)) - Target.Value = 0: Tm = Format(Dn.Offset(, 1) - Target.Value, "hh:mm")
                                Case DateValue(Dn.Value) - Target.Value = 0: Tm = Format(24 - (Dn.Value - Target.Value), "hh:mm")
                                Case DateValue(Dn.Offset(, 1)) - Target.Value <> 0: Tm = "24:00:00"
                       End Select
                        Cells(C, 2).NumberFormat = "General"
                        Cells(C, 2) = Tm
                    End If
                 Next Dt
            Next Dn
    End If
Application.EnableEvents = True
End Sub

Regards Mick

 

[hashi2c]

Thanks for your help Mick, That works perfectly............