Get row from Sheet 2 if date between certain values

[omnikron32]

Hi there,

I'm struggling with an excel VBA script - which I've just scrapped and started again.

I've got a table with three columns:

A - the date published
B - the title
C - the contact information

Now on the first worksheet, I need to have two cells with dates and a button I can click.

When you click the button, it'll list all the rows for which the date falls between the value in cell A.

Is this possible in VBA? I've managed to get the values to transfer from one sheet to the next, but I don't know how to delete and sort based on the date.:wot

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim cell As Range
Dim sh As Worksheet

With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns(1).AutoFilter _
field:=1, _
Criteria1:=">=" & Format(ActiveSheet.Range("M1").Value, Worksheets("Sheet1").Range("A2").NumberFormat), _
Criteria2:="<=" & Format(ActiveSheet.Range("M2").Value, Worksheets("Sheet1").Range("A2").NumberFormat)

.Range("A1").Resize(LastRow, 3).SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Range("A1")
.Columns(1).AutoFilter
End With

End Sub

[omnikron32]

fantastic - thanks very much for your help!

Unfortunately - I seem to be getting a runtime 1004 - the command could not be completed with the range specified.

I'm sure it's me being stupid - is it possible for you to upload an excel file so I can spot the difference!?

[Bob Phillips]

Here you are

[omnikron32]

oh I've totally messed it up! - it kept leaving the second sheet filtered so all the values disappeared so I tried to fix it and it broke completely! :banghead: :banghead: :banghead:

Could someone have a look at this (file attached) and see if they can figure out my stupidity.

You'll see what I'm trying to do - ideally I'd like it if they clicked a cell within the calendar range with a number (ie a date) then it'd look for the next 7 days worth of work - I dunno if this is possible at all :dunno

[omnikron32]

ok I've almost got it working - but why does this say no cells found?

[Bob Phillips]

You have to filter the correct row



Private Sub CommandButton2_Click()
Dim i As Long
Dim LastRow As Long
Dim rng As Range
Dim sh As Worksheet

Set sh = Worksheets("Calendar")

With Worksheets("Workstack")

LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row

'Sort the columns so only the required tasks are visible
.Columns(5).AutoFilter _
Field:=1, _
Criteria1:=">=" & Format(sh.Range("AB3").Value, .Range("E2").NumberFormat), _
Operator:=xlAnd, _
Criteria2:="<=" & Format(sh.Range("AC3").Value, .Range("E2").NumberFormat)

On Error Resume Next
Set rng = .Range("B2").Resize(LastRow, 4).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
rng.Copy sh.Range("Z5")
End If
.Columns(1).AutoFilter
End With
End Sub

[omnikron32]

ah! fantastic! Thank you so much for your help - I'm starting to understand this better now.

Can I ask if it's possible to run this macro when the cells AB3 or AC4 change (ie the ones with the dates!)?

At the moment you need to click the button, but it'd be smoother if it could just be done immediately after the cell is updated?

[Bob Phillips]

THis goes in the same code module as the commandbutton code, as a replacement for that code



Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "AB3:AC3"
Dim LastRow As Long
Dim rng As Range
Dim i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

If IsDate(Target.Value) Then

LastRow = Me.Cells(Me.Rows.Count, "Z").End(xlUp).Row
Me.Range("Z5").Resize(LastRow - 4, 4).ClearContents
With Worksheets("Workstack")

LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row

'Sort the columns so only the required tasks are visible
.Columns(5).AutoFilter _
Field:=1, _
Criteria1:=">=" & Format(Me.Range("AB3").Value, .Range("E2").NumberFormat), _
Operator:=xlAnd, _
Criteria2:="<=" & Format(Me.Range("AC3").Value, .Range("E2").NumberFormat)

On Error Resume Next
Set rng = .Range("B2").Resize(LastRow, 4).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then
rng.Copy Me.Range("Z5")
End If
.Columns(1).AutoFilter
End With
End If
End If

ws_exit:
Application.EnableEvents = True

End Sub