No announcement yet.

VBA search for records in date range

  • Filter
  • Time
  • Show
Clear All
new posts

  • VBA search for records in date range


    I'm trying to develop a tool using VBA that will search a worksheet ("Log") that contains thousands of records. In a second worksheet ("Search"), the user selects two dates from drop down calendars, and then enters 3 search terms in cells B6, C6, and D6. The Search tool needs to find records that fall within the date range and contains at least one of the keywords, copying and pasting the records into the Search sheet and removing any duplicates. I tried to write the code myself (please see attached) but I am new to VBA and could use some help. I used some dummy sports data for testing purposes.

    Thank you!

    - Annie
    Attached Files

  • #2
    Re: VBA search for records in date range


    This should do what you want..

    Note: I am 100% sure there would be better ways to do it.. but I tested this well and it works nicely..

    If anyone else reading this has any suggestions on how i could coded this better... please let me know.. then hopefully i will learn from it..
    I added an ID column so that i could base the deletion of duplicate rows on that..

    You should be able to adapt it to your real data..

    Edit: I am thinking that an improvement you could implement is to make it so the 3 Search boxes are in fact drop downs (Data Validation Lists that are populated with all the possible Keywords).. that way.. all the User has to do is select from the drop down.. instead of typing it in (prone to speeling mitsakes etc.. )

    This code goes in your "Search" sheet..

    Private Sub CommandButton1_Click()
    Dim arr As Variant
      Dim S1 As String
      Dim S2 As String
      Dim S3 As String
      Dim SArray As String
      Dim Response1 As String
      Dim Response2 As String
      Dim Response3 As String
      Dim LastRowAdd As String
      Dim LastRow As Long
      Dim LastSearch As Long
      Dim FirstRowAdd As String
      Dim FirstRow As Long
      Dim i As Long
      Dim c As Long
      Dim R As Long
      Dim N As Long
      Dim V As Variant
      Dim Rng As Range
      Dim R2 As Range
    StartDate = DTPicker1
    EndDate = DTPicker2
    Sheets("Log").Range("A3:M14").AutoFilter Field:=11, Criteria1:=">=" & Format(StartDate, "mm/dd/yyyy"), Operator:=xlAnd, _
    Criteria2:="<=" & Format(EndDate, "mm/dd/yyyy")
      S1 = Sheets("Search").Cells(6, 3).Value
      S2 = Sheets("Search").Cells(6, 4).Value
      S3 = Sheets("Search").Cells(6, 5).Value
      FirstRowAdd = FirstVisibleValue(ActiveSheet, 7)
      FirstRow = Range(FirstRowAdd).Row
      LastRow = Sheets("Log").Range("G" & Rows.Count).End(xlUp).Row
      LastRowAdd = Cells(LastRow, "G").Address
      For i = FirstRow To LastRow
      Set R2 = Sheets("Log").Cells(i, 7)
      If R2.EntireRow.Hidden = True Then
            GoTo 8
        End If
      c = 0
      SArray = Sheets("Log").Cells(i, 7).Value
      arr = Split(SArray, ",")
      If S1 = "" Then GoTo 1
      Response1 = IsInArray(S1, arr)
     If Response1 = "True" Then
     c = 1
     GoTo 3
     End If
     If S2 = "" Then GoTo 2
      Response2 = IsInArray(S2, arr)
     If Response2 = "True" Then
     c = 1
      GoTo 3
     End If
     If S3 = "" Then GoTo 3
      Response3 = IsInArray(S3, arr)
     If Response3 = "True" Then
     c = 1
      GoTo 3
     End If
    If c = 1 Then
    Sheets("Log").Cells(i, 1).EntireRow.Copy Destination:=Sheets("Search").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
     Next i
     Sheets("Log").AutoFilterMode = False
    On Error GoTo EndMacro
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    LastRowSearch = Sheets("Search").Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = Sheets("Search").Range(Cells(10, 1), Cells(LastRowSearch, 1))
    Application.StatusBar = "Processing Row: " & Format(Rng.Row, "#,##0")
    N = 0
    For R = Rng.Rows.Count To 2 Step -1
    If R Mod 500 = 0 Then
        Application.StatusBar = "Processing Row: " & Format(R, "#,##0")
    End If
    V = Rng.Cells(R, 1).Value
    If V = vbNullString Then
        If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
            N = N + 1
        End If
        If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
            N = N + 1
        End If
    End If
    Next R
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    If N > 0 Then
    MsgBox "Duplicate Rows Deleted: " & CStr(N)
    End If
    End Sub
    And these 2 functions go in a Module..
    Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
      IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
    End Function
    Function FirstVisibleValue(ByRef Sht As Worksheet, ByVal FilterCol As Long)
        Dim R As Range
        If Sheets("Log").AutoFilterMode Then
            Set R = Sheets("Log").AutoFilter.Range
            FirstVisibleValue = R.Offset(1, FilterCol - 1).Resize(R.Rows.Count, 1).SpecialCells(12).Cells(1).Address
        End If
    End Function
    Attached Files
    Last edited by apo; May 30th, 2013, 20:35. Reason: Improvement idea..
    Valuable Resources:

    snb's Website:

    Smallmans Website:


    • #3
      Re: VBA search for records in date range

      Hi Apo,

      This is totally brilliant. Thank you so much. I easily adapted the code to my actual worksheet and it worked like a charm!

      - Annie


      • #4
        Re: VBA search for records in date range


        Any thoughts on the improvement idea I mentioned?
        Valuable Resources:

        snb's Website:

        Smallmans Website:


        • #5

          Re: VBA search for records in date range

          In theory, you're right that drop downs would alleviate a lot of user search issues, but the actual spreadsheet has thousands of records with an infinite number of keywords. Unfortunately, I feel that this would be too difficult to maintain. But that is a great idea!