Search on Date Range - Copy Row with matching Date 1

[Airbisk]

Hi,

I found the program below and have amended it to suit the needs. The needs have changed. Currently the program would look at the date entered in F15 and pull into Search Results all the rows where that date appears in Column I of the Site Print Worksheet.

Now a Date to field has been added in F17. Would you be able to help with some guidance with incorporating a way of looking at the Date From and Date To and pulling back the rows where a date within the range appears in Column I.

Many Thanks in Advance


Sub fohdatemoving()
Dim c As Range, d As Range

If Range("F15") = "" Then

MsgBox "Please Select a FOH Date From"


ElseIf Range("F17") = "" Then

MsgBox "Please Select a FOH Date To"

Else

Worksheets("Search Results").Activate
Application.ScreenUpdating = False
Cells.Select
Selection.ClearContents
Range("A1").Select

Sheets("Site Print").Select
Rows("1:1").Select
Selection.Copy
Sheets("Search Results").Select
Rows("1:1").Select
ActiveSheet.Paste

For Each c In Worksheets("Site Print").Range("I1:I8000")
For Each d In Worksheets("Criteria").Range("F15")
If c = d Then
c.EntireRow.Copy Worksheets("Search Results").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next

Cells.Select
Cells.EntireColumn.AutoFit
Range("D3").Select
Columns("D").ColumnWidth = 48.71
Columns("O:O").ColumnWidth = 38.86
Columns("A:A").ColumnWidth = 8.29
Rows("1:1").RowHeight = 15.75

Range("A1").Select

End If

End Sub

 

[SkipVought]

Please post VBA code questions in forum707.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Airbisk]

Ah, reposted into correct forum.

 

[SkipVought]

    Dim c As Range, [b]dFrom As Date, dThru As Date[/b]
    
    If Range("F15") = "" Then
    
        MsgBox "Please Select a FOH Date From"
        
        
    ElseIf Range("F17") = "" Then
    
        MsgBox "Please Select a FOH Date To"
        
    Else
    [b]
        dFrom = Range("F15").Value
        dThru = Range("F17").Value
        [/b]
        Worksheets("Search Results").Activate
        Application.ScreenUpdating = False
        Cells.Select
        Selection.ClearContents
        Range("A1").Select
        
        Sheets("Site Print").Select
        Rows("1:1").Select
        Selection.Copy
        Sheets("Search Results").Select
        Rows("1:1").Select
        ActiveSheet.Paste
        
        For Each c In Worksheets("Site Print").Range("I1:I8000")
            For Each d In Worksheets("Criteria").Range("F15")[b]
                If c.value >= dFrom And c.value <= dThru Then[/b]


Skip,
[sub]
[glasses]Just traded in my old subtlety...
[b]for a NUANCE![/b][tongue][/sub]

 

[Airbisk]

Spot on thanks Skip