Query/Search and Display

[maxflia10]

Is it possible to enter a date in another sheet and run some code that finds the date and displays the rows below, much like HLOOKUP? My boss wants to enter a date and then displays any information pertaining to the date. I have attached a sheet and will have the 12 months in the same workbook. Is it possible to search all worksheets (named after the months) or will this be done separately. Thanks for taking a look.

[Zack Barresse]

Hi Brian, how are ya?

Is the sheet in the example file the portion that will be returned when you enter a date value? And it will be looking at 'December 01', 'December 02', etc?

If this is the case, where will this Change occur, and what would you like to fire it (e.g. specific cell change, a difference in previous value, selection change, double click, etc.), and where is it located?

[maxflia10]

Hi Brian, how are ya?

Is the sheet in the example file the portion that will be returned when you enter a date value? And it will be looking at 'December 01', 'December 02', etc?

If this is the case, where will this Change occur, and what would you like to fire it (e.g. specific cell change, a difference in previous value, selection change, double click, etc.), and where is it located?

Hey Zack!

The attached file will serve as the data base. On another sheet, if i entered say 12/10, the macro would find the date in the data base and return the next 32 rows below the date.

[Zack Barresse]

Brian,

You can use something like this in your worksheet module of the sheet you are bringing back from. I have uploaded your sample file. Code is as follows ...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub 'header row
    If Not IsDate(Target.Value) = True Then
        MsgBox "Please enter a valid date.", vbInformation, "ERROR"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Dim myMonth As String, longMonth As String, myDay As Long, _
        c As Long, r As Long, rng As Range, foundRng As Range
    Select Case month(Target.Value)
    Case 1: myMonth = "Jan": longMonth = "January"
    Case 2: myMonth = "Feb": longMonth = "February"
    Case 3: myMonth = "Mar": longMonth = "March"
    Case 4: myMonth = "Apr": longMonth = "April"
    Case 5: myMonth = "May": longMonth = "May"
    Case 6: myMonth = "Jun": longMonth = "June"
    Case 7: myMonth = "Jul": longMonth = "July"
    Case 8: myMonth = "Aug": longMonth = "August"
    Case 9: myMonth = "Sep": longMonth = "September"
    Case 10: myMonth = "Oct": longMonth = "October"
    Case 11: myMonth = "Nov": longMonth = "November"
    Case 12: myMonth = "Dec": longMonth = "December"
    End Select
    myDay = day(Target.Value)
    On Error GoTo endMe
    With Sheets(myMonth)
        Set rng = .Cells.Find(longMonth & " " & myDay, , _
            xlValues, , , True, False)
        If Not rng Is Nothing Then
            Set foundRng = rng.Offset(2, -2)
            For c = 1 To 8
                For r = 0 To 29
                    Target.Offset(r, c).Value = foundRng.Offset(r, c - 1).Value
                Next r
            Next c
        Else
            MsgBox "Cannot find a date match.", vbInformation, "ERROR"
        End If
    End With
endMe:
    Application.ScreenUpdating = True
    Err.Clear
End Sub

...

[maxflia10]

Thanks Zack! :rofl

I'll show it to my boss. He'd better like it!

[Zack Barresse]

One caveat might be, and we can work it into the code, is if data exist in the cells next door (to the right), have a popup msgbox saying that data already exists there, asking to overwrite or not. Let me know if you'd like that in there.

Hope he does like it.

[maxflia10]

Zack,

The file (data base) is on a network. Would it be possible to run the query from another workbook? Have the query in a workbook where my boss would be the only one that can run a query? Versus having the worksheet in the same workbook as the data.

[maxflia10]

Zack,

I added a worksheet name Query to my workbook changed the name from sheet1 to Query in the code, added the macro, but it doesn't display. I have a workbook open event to set calculation to manual and back to auto upon closing. It seems to be searching for a date, but doesn't return anything......

[Zack Barresse]

Can you load up that file as well?

And to make sure, you want to have this Query file, you make a change in a location and it updates from the other file, right?

[maxflia10]

Good Morning Zack,

I have attached the file. I've decided to simply have the Query sheet in the same workbook. Also, I'll only be looking up one day at any one time, so what displays can be only the first block on information in the Query sheet. That is, I don't need to have 2 or more dates to return informaton from. Thanks again for taking the time....

[Zack Barresse]

Okay Brian, try this ...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub 'header row
    If Not IsDate(Target.Value) = True Then
        MsgBox "Please enter a valid date.", vbInformation, "ERROR"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Dim c As Long, r As Long, Rng As Range, foundRng As Range
    With Sheets(Format(Target.Value, "mmm"))
        Set Rng = .Cells.Find(Format(Target, "mmmm dd"), , LookIn:=xlValues)
        If Not Rng Is Nothing Then
            Set foundRng = Rng.Offset(2, -2)
            Application.EnableEvents = False
            For c = 1 To 8
                For r = 0 To 29
                    Target.Offset(r, c).Value = foundRng.Offset(r, c - 1).Value
                Next r
            Next c
        Else
            MsgBox "Cannot find a date match.", vbInformation, "ERROR"
        End If
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

File attached

...

[maxflia10]

Zack,


COOL!

Much thanks!

[Zack Barresse]

No problem.

So does that work for you then?

[maxflia10]

Zack,


It does work and will test it further this coming week. I'll be sure to let you know!