Creating search bar on to search data in between dates

[Sayan2795]

Hi,
I need to create a search box in Excel. So to give a background I created a macro to extract data from multiple reports in to an Excel sheet and the data is column wise with the DATE as the header of each column. The number of columns keep changing based on the number of report used to extract the data. Each report gives one column and a date as header

Now after the data is extracted I need to create a search box to extract the data between two specific dates. The dates are in ascending order. So I need two boxes on the sheet where I will input the dates in between which the data I need and copy the data in the next sheet

Please help

 

[Yongle]

Test as follows and then adapt to your own requirements
- create a new workbook
- copy & paste values below into sheet1 (range A1: J4)

A1	18/09/2018	08/10/2018	28/10/2018	17/11/2018	07/12/2018	27/12/2018	16/01/2019	05/02/2019	25/02/2019
ID_001	b2	c2	d2	e2	f2	g2	h2	i2	j2
ID_002	b3	c3	d3	e3	f3	g3	h3	i3	j3
ID_003	b4	c4	d4	e4	f4	g4	h4	i4	j4

<tbody>
</tbody>

- insert 2 Active-X listboxes (which will be automatically named ListBox1 and ListBox2) anywhere below the pasted values
- paste the code below into the sheet module
- ensure Excel is not in "Design Mode"
- click on ListBox1 and both listboxes are updated with valid dates
- select a date in ListBox1
- select a later date in ListBox2
- click anywhere outside the listbox and a worksheet is added containing the copied values
- get it working unchanged first and let me know if you want something different

All code goes in sheet module (right-click on sheet tab\ View Code \ paste in code window \ {alt}{F11} to go back to Excel)

Private Sub ListBox1_GotFocus()
    Call RefreshDates(Me.ListBox1)
    Call RefreshDates(Me.ListBox2)
    ListBox1.Height = 100
    ListBox2.Height = 100
End Sub

Private Sub RefreshDates(listbox)
    Application.EnableEvents = False
    Dim date1 As Range, date2 As Range
    Dim day As Range
    Set date1 = Me.Range("B1")
    Set date2 = Me.Cells(1, Columns.Count).End(xlToLeft)
    listbox.Object.Clear
        For Each day In Range(date1, date2)
            listbox.Object.AddItem Format(day, "dd/mm/yyyy")
        Next day
    Application.EnableEvents = True
  End Sub

Private Sub ListBox2_LostFocus()
    Dim ws As Worksheet, c1 As Long, c2 As Long, x As Integer
    
    For x = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(x) = True Then c1 = x + 2
        If ListBox2.Selected(x) = True Then c2 = x + 2
    Next x
    If c2 >= c1 Then
        Set ws = Worksheets.Add(after:=Me)
        Me.Columns(1).Copy ws.Cells(1, 1)
        Me.Columns(c1).Resize(, c2 - c1 + 1).Copy ws.Cells(1, 2)
    End If
End Sub

NOTE
The code makes no attempt to match dates (which can be tricky!)
- dates are added individually to the list box making it easy to "convert" selected date to column number
- the 2 in these lines is added because dates start in column 2

If ListBox1.Selected(x) = True Then c1 = x + [COLOR=#ff0000]2[/COLOR]
If ListBox2.Selected(x) = True Then c2 = x + [COLOR=#ff0000]2[/COLOR]

 

[Sayan2795]

Thank you @Yongle for your prompt reply
I am getting an application defined or object defined error in this line :
Me.Columns(c1).Resize(, c2 - c1 + 1).Copy ws.Cells(1, 2)

Also how can we add a button which can be used to search after we select the dates.
Thank you for your time

 

[Yongle]

I am getting an application defined or object defined error in this line :
Me.Columns(c1).Resize(, c2 - c1 + 1).Copy ws.Cells(1, 2)

I am puzzled - I would expect that only to happen if nothing is selected the first listbox (I did not include a check for that )

I tested from scratch again - it works without error for me on Excel 2016. Which version of Excel are you running?

Just to makes sure - please give it another try and repeat my instructions from the beginning

The only reason for it to error on that line is if it is getting a stupid number for the first column or the resize
To help us debug, please insert this line immediately above the line that errors

MsgBox "C1: " & c1 & vbCr & "C2: " & c2 & vbCr & "Columns" & c2 - c1 + 1

Test it a few times
C1 should be the first column, C2 the last column and Columns is the number of columns

Let me know what you discover and we'll take it from there