Loading
Ozgrid Excel Help & Best Practices Forums

Excel Video Tutorials / 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,074

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

    VB:
    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..
    VB:
    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 20: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,074

    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, 21:43
  2. Copy Records Based On Date Range
    By Jbreed03 in forum EXCEL HELP
    Replies: 5
    Last Post: November 19th, 2009, 09:24
  3. Search Table For Date In Date Range
    By Quorum in forum EXCEL HELP
    Replies: 9
    Last Post: July 1st, 2008, 21:37
  4. Search for records by date
    By shaneF-16 in forum EXCEL HELP
    Replies: 4
    Last Post: August 11th, 2005, 23:01
  5. Returning the number of records with an date range
    By Analyst84 in forum EXCEL HELP
    Replies: 4
    Last Post: September 27th, 2004, 23: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