Use Find to search and return Multiple Dates

[thomachr]

I am working with a macro into which you input a date, the macro searches for that date (in column D of the data sheet), then copies any row with that date onto a new sheet.

This works great, but now I need to be able to search for more than one date at a time and return any rows that cantain ANY of those dates. For example, I would want to search for any row containing 01/01/07 - 01/07/07 or any row containing 01/01/07, 01/02/07, 01/03/07...01/07/07.

Does anyone know of a way I could edit the macro to search for more than one date at a time?

 

[thomachr]

I have been testing using this (much smaller scale) and it is working for me with or without protection.
I am not sure what I am missing with your specific situation.

I am supposed to be looking for the dates in Column D for sure right?

Yes, Dates are in Column D. The macro runs to completion, I see the "done" message box, but but no records are returned, even for dates I know to have multiple records for and I have no idea what is wrong.

Thanks again for your continued help.

 

[brian.wethington]

I am doubting this is the issue you are having but this is a better way to do the rnglen portion of the code

RngLen = Abs(FindThis2 - FindThis)
If FindThis2 < FindThis Then FindThis = FindThis2

as opposed to

If FindThis2 > FindThis Then 
    RngLen = FindThis2 - FindThis 
Else 
    RngLen = FindThis - FindThis2 
End If

Other than that I am still trying to get it not to work for me. I have tried many things. putting an apostrophe before and many other things and I am still not getting a scenario in which the code will not work for my needs. I have not given up though. Just wanted to post the replacement for the half thought through code I gave you before. Perhaps someone else will come up with what I am missing or perhaps a better approach for you to take. I will continue looking at this though.

 

[thomachr]

I am doubting this is the issue you are having but this is a better way to do the rnglen portion of the code

RngLen = Abs(FindThis2 - FindThis)
If FindThis2 < FindThis Then FindThis = FindThis2

as opposed to

If FindThis2 > FindThis Then 
    RngLen = FindThis2 - FindThis 
Else 
    RngLen = FindThis - FindThis2 
End If

Other than that I am still trying to get it not to work for me. I have tried many things. putting an apostrophe before and many other things and I am still not getting a scenario in which the code will not work for my needs. I have not given up though. Just wanted to post the replacement for the half thought through code I gave you before. Perhaps someone else will come up with what I am missing or perhaps a better approach for you to take. I will continue looking at this though.

Brian, I really apreciate the work you are doing on this.

I am headed out of town so won't get a chance to look at it again before Tuesday, so don't be alarmed if I am MIA for a few days. If you figure something out, please post away, but I will get back with you when I return to try and work through the issue.

thanks again!

 

[thomachr]

Success!

With some further digging, I found that the issue was i was searching xlvalues instead of xlformula, and thus the find comand was returning nothing. Here is the code I am now using. Thanks again for you help!

'============================================
'- Update August 2007
'- FIND RECORDS FROM A RANGE OF DATES IN A DATA TABLE
'- AND COPY SELECTED COLUMNS INTO A SUMMARY SHEET
'- change "DataSheet" to lookup sheet name
'- change "SummarySheet" to summary sheet name
'_ change ranges as appropriate
'- Original Code: Brian Baulsom February 2005
'- Edits: Brian Wethington August 2007
'- Edits: Chris Thoma August 2007
'=============================================
'-
Sub FindRecords()
    Dim FromSheet As Worksheet
    Dim FromRow As Long
    Dim ToSheet As Worksheet
    Dim ToRow As Long
    Dim FindThis As Date
    Dim FoundCell As Object
    Dim Wbfrom As Workbook
    Dim FirstAddress As String
    Dim FindThis2 As Date
    Dim RngLen As Long
    Dim x As Long
    
    '---------------------------------------------------
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    '---------------------------------------------------
    '- get user inputs
    FindThis = InputBox("Please enter start date: ")
    FindThis2 = InputBox("Please enter end date: ")
    RngLen = Abs(FindThis2 - FindThis)
    If FindThis2 < FindThis Then FindThis = FindThis2
    
    '---------------------------------------------------
    Set Wbfrom = Workbooks.Open(Filename:="DataSheetFile)")
    Set FromSheet = Wbfrom.Worksheets("DataSheet")
    Set ToSheet = ThisWorkbook.Worksheets("SummarySheet")
    ToRow = 2
    
    '---------------------------------------------------
    '- clear summary for new data
    ToSheet.Cells.Range("A2:BE5000").Clear
    
    '---------------------------------------------------
    ' FIND DATA
    For x = 0 To RngLen
        With FromSheet.Range("D2:D5000")
            Set FoundCell = .Find(FindThis + x, LookIn:=xlFormulas)
            If Not FoundCell Is Nothing Then
                FirstAddress = FoundCell.Address
                '------------------------------------------
                '- copy selected columns of data to report
                Do
                    FromRow = FoundCell.Row
                    FromSheet.Cells(FromRow, 1).Copy ToSheet.Cells(ToRow, 1)
                    FromSheet.Cells(FromRow, 2).Copy ToSheet.Cells(ToRow, 2)
                    FromSheet.Cells(FromRow, 4).Copy ToSheet.Cells(ToRow, 3)
                    FromSheet.Cells(FromRow, 6).Copy ToSheet.Cells(ToRow, 4)
                    FromSheet.Cells(FromRow, 7).Copy ToSheet.Cells(ToRow, 5)
                    FromSheet.Cells(FromRow, 8).Copy ToSheet.Cells(ToRow, 6)
                    FromSheet.Cells(FromRow, 10).Copy ToSheet.Cells(ToRow, 7)
                    FromSheet.Cells(FromRow, 11).Copy ToSheet.Cells(ToRow, 8)
                    FromSheet.Cells(FromRow, 13).Copy ToSheet.Cells(ToRow, 9)
                    FromSheet.Cells(FromRow, 19).Copy ToSheet.Cells(ToRow, 10)
                    FromSheet.Cells(FromRow, 28).Copy ToSheet.Cells(ToRow, 11)
                        
                    ToRow = ToRow + 1
                    Set FoundCell = .FindNext(FoundCell)
                Loop While Not FoundCell Is Nothing And _
                    FoundCell.Address <> FirstAddress
                      
                '------------------------------------------
            End If
        End With
    Next x
    Application.Workbooks("DataSheetFile").Close SaveChanges:=False
    MsgBox ("Done.")
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub