Loading
Ozgrid Excel Help & Best Practices Forums

Excel Training / Excel Dashboards Reports



Results 1 to 5 of 5

Thread: VBA search for records in date range

  1. #1
    Join Date
    21st September 2012
    Posts
    11

    VBA search for records in date range

    Hi

    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. REMINDER! OzGrid accepts no responsibility for ANY adverse effects as a result from downloading attached files. ALWAYS run an up-to-date virus scan and disable macros.

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    15th April 2013
    Location
    Wirrimbi, NSW
    Posts
    1,308

    Re: VBA search for records in date range

    Hi..

    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..

    Code:
    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
     
    1
     If S2 = "" Then GoTo 2
      Response2 = IsInArray(S2, arr)
     
     If Response2 = "True" Then
     c = 1
      GoTo 3
     End If
     
    2
     If S3 = "" Then GoTo 3
      Response3 = IsInArray(S3, arr)
      
     If Response3 = "True" Then
     c = 1
      GoTo 3
     End If
     
    3
    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
    
    8
     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
            Rng.Rows(R).EntireRow.Delete
            N = N + 1
        End If
    Else
        If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
            Rng.Rows(R).EntireRow.Delete
            N = N + 1
        End If
    End If
    Next R
    
    EndMacro:
    
    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..
    Code:
    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. REMINDER! OzGrid accepts no responsibility for ANY adverse effects as a result from downloading attached files. ALWAYS run an up-to-date virus scan and disable macros.
    Last edited by apo; May 30th, 2013 at 21:35. Reason: Improvement idea..

    Excel Video Tutorials / Excel Dashboards Reports


  3. #3
    Join Date
    21st September 2012
    Posts
    11

    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

    Excel Video Tutorials / Excel Dashboards Reports


  4. #4
    Join Date
    15th April 2013
    Location
    Wirrimbi, NSW
    Posts
    1,308

    Re: VBA search for records in date range

    Hi..

    Any thoughts on the improvement idea I mentioned?

    Excel Video Tutorials / Excel Dashboards Reports


  5. #5
    Join Date
    21st September 2012
    Posts
    11

    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!

    Excel Video Tutorials / Excel Dashboards Reports


Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Macro to Search for documents expiry in database for given date range
    By xlAddict in forum Excel and/or Access Help
    Replies: 1
    Last Post: September 8th, 2012, 22:43
  2. Copy Records Based On Date Range
    By Jbreed03 in forum EXCEL HELP
    Replies: 5
    Last Post: November 19th, 2009, 10:24
  3. Search Table For Date In Date Range
    By Quorum in forum EXCEL HELP
    Replies: 9
    Last Post: July 1st, 2008, 22:37
  4. Search for records by date
    By shaneF-16 in forum EXCEL HELP
    Replies: 4
    Last Post: August 12th, 2005, 00:01
  5. Returning the number of records with an date range
    By Analyst84 in forum EXCEL HELP
    Replies: 4
    Last Post: September 28th, 2004, 00:58

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
porno