Search Database

[ashani]

hi
I'm trying to create a search option from a database and using the following formula. It's working fine but I would like to define 7 search criteria and I wonder if someone can please help me with that. I have attached a screenshot to show how it will look. Also out of 7 criteria - the system should show either an exact match or whichever meets or closer. Really appreicate your help.

Sub searchdata()
Dim erow As Long
Dim ws As Worksheet
Dim lastrow As Long
Dim count As Integer

lastrow = Sheets("Database").Cells(Rows.count, 1).End(xlUp).Row
count = 0
For x = 2 To lastrow

If Sheets("Database").Cells(x, 1) = Sheets("Search").Range("E4") Then
Sheets("Search").Range("A15") = Sheets("Database").Cells(x, 1)
Sheets("Search").Range("B15") = Sheets("Database").Cells(x, 2)
Sheets("Search").Range("C15") = Sheets("Database").Cells(x, 3)
Sheets("Search").Range("d15") = Sheets("Database").Cells(x, 4)
Sheets("Search").Range("e15") = Sheets("Database").Cells(x, 5)
Sheets("Search").Range("F15") = Sheets("Database").Cells(x, 6)
Sheets("Search").Range("G15") = Sheets("Database").Cells(x, 7)
Sheets("Search").Range("H15") = Sheets("Database").Cells(x, 8)
Sheets("Search").Range("I15") = Sheets("Database").Cells(x, 9)
Sheets("Search").Range("J15") = Sheets("Database").Cells(x, 10)
Sheets("Search").Range("K15") = Sheets("Database").Cells(x, 11)
Sheets("Search").Range("L15") = Sheets("Database").Cells(x, 12)
Sheets("Search").Range("M15") = Sheets("Database").Cells(x, 13)
Sheets("Search").Range("N15") = Sheets("Database").Cells(x, 14)
Sheets("Search").Range("O15") = Sheets("Database").Cells(x, 15)
Sheets("Search").Range("P15") = Sheets("Database").Cells(x, 16)
Sheets("Search").Range("Q15") = Sheets("Database").Cells(x, 17)
Sheets("Search").Range("R15") = Sheets("Database").Cells(x, 18)
Sheets("Search").Range("S15") = Sheets("Database").Cells(x, 19)
Sheets("Search").Range("T15") = Sheets("Database").Cells(x, 20)
Sheets("Search").Range("U15") = Sheets("Database").Cells(x, 21)
Sheets("Search").Range("V15") = Sheets("Database").Cells(x, 22)
Sheets("Search").Range("W15") = Sheets("Database").Cells(x, 23)
Sheets("Search").Range("X15") = Sheets("Database").Cells(x, 24)
Sheets("Search").Range("Y15") = Sheets("Database").Cells(x, 25)
Sheets("Search").Range("Z15") = Sheets("Database").Cells(x, 26)
Sheets("Search").Range("AA15") = Sheets("Database").Cells(x, 27)
Sheets("Search").Range("AB15") = Sheets("Database").Cells(x, 28)
Sheets("Search").Range("AC15") = Sheets("Database").Cells(x, 29)
Sheets("Search").Range("AD15") = Sheets("Database").Cells(x, 30)
Sheets("Search").Range("AE15") = Sheets("Database").Cells(x, 31)
Sheets("Search").Range("AF15") = Sheets("Database").Cells(x, 32)
Sheets("Search").Range("AG15") = Sheets("Database").Cells(x, 33)
count = count + 1

End If

Next x

End Sub

 

[mse330]

Hello ashani,

Looking at your code & the posted picture, I have noticed couple of issues with your code

1. In your loop, you're fixing the output (Search Sheet) in row 15 always where every time a record is found, it basically overwrites the previously found record.
2. Since the data structure is the same in both sheets (from column A to AG), instead of looping through it cell by cell, you could assign the complete range all at once which would result in less lines of code & it also is much better in terms of performance. You could re-write your code like below

Sub searchdata()

Dim Ws1 As Worksheet, Ws2 As Worksheet, count As Long, lastrow As Long

Set Ws1 = Sheets("Search")
Set Ws2 = Sheets("Database")
lastrow = Ws2.Cells(Rows.count, 1).End(xlUp).Row
count = 15

For x = 2 To lastrow
    If Ws2.Cells(x, 1) = Ws1.Range("E4") Then
        Ws1.Range(Ws1.Cells(count, "A"), Ws1.Cells(count, "AG")) = Ws2.Range(Ws2.Cells(x, "A"), Ws2.Cells(x, "AG")).Value
        count = count + 1
    End If
Next x

End Sub

Now going back to your requirement, I believe the simplest way to accomplish what you need is to use Advanced Filter (if you are not aware of it, I highly encourage you to read more about it HERE). This should take care of all your search criteria (single or multiple items) from all 8 fields. Give the below code a try on a copy of your file & let me know how it goes

Sub Search()

Dim Rg As Range

With Sheets("Search")
    .[O1].Resize(, 8) = Array("Name", "Available", "Key Stage", "Country", "Sector", "Curriculum", "Area", "Subject")
    .[O2].Resize(, 4) = Application.Transpose(.[E4:E7])
    .[O2].Offset(, 4).Resize(, 4) = Application.Transpose(.[K4:K7])
    Set Rg = .[O1:V2]
    If .[A15] <> "" Then .Range("A15", .Range("A" & Rows.count).End(xlUp)).EntireRow.ClearContents
    Sheets("Database").UsedRange.AdvancedFilter xlFilterCopy, Rg, .[A15]
    .Rows(15).EntireRow.Delete
    Rg.ClearContents
End With

End Sub

 

[ashani]

hi @mse330
Thank you for your reply.
I'm still struggling to get this right. I want to bring anything matching from Search criteria to bring it down from database but it's only bringing from the Name and not picking up other search areas. I'm using the below coding.

Sub searchdata()

Dim Ws1 As Worksheet, Ws2 As Worksheet, count As Long, lastrow As Long

Set Ws1 = Sheets("Search")
Set Ws2 = Sheets("Database")
lastrow = Ws2.Cells(Rows.count, 1).End(xlUp).Row
count = 15

For x = 2 To lastrow
    If Ws2.Cells(x, 1) = Ws1.Range("E4") Then
        Ws1.Range(Ws1.Cells(count, "A"), Ws1.Cells(count, "AG")) = Ws2.Range(Ws2.Cells(x, "A"), Ws2.Cells(x, "AG")).Value
        count = count + 1
    End If
Next x

End Sub

thank you

 

[mse330]

Hi ashani,

Try the 2nd code I provided in post # 2 which uses the Advanced Filter

 

[ashani]

Hi @mse330

Thank you for response sir.

I'm trying the 2nd code but for some reason it's not working. When I use it - it's bringing the heading from database rather than the actual search. Here is the screenshot

 

[mse330]

What did you search ? I see that all search cells are empty

 

[ashani]

hi @mse330
I tried multiple search from database - here is the screenshot for Search & Database

 

[mse330]

Looking at your second sheet just revaled few points to me

1. I didn't know your other sheet data starts from row #5
2. It has merged cells ? Merged cells do go well with VBA
3. You have only one cell to search for sector but 5 cells (sub-sector) under it, which column do you wish to check against ? All of them ? Similarly for other items Curriculum, Area, Subject … etc.

With the above points, I don't think my previous code will work. If you can upload your file online (Drop Box for example) & share the link with us here just replace the actual data with dummy data then I might be able to re-work the appropriate code for you

 

[ashani]

Hi @mse330

Thank you for your reply and apologise for the confusion.

I want the search criteria to be either way - the idea is to put any criteria and whichever matches that appears - that could be all 7 boxes or just 1 out of 7.

I don't have dropbox ac - but if you could message me your email address and I can share the file.

Thank you once again for all your help.

 

[ashani]

hi @mse330
Thank you for looking to help.
Here is the link of dropbox where I have uploaded a file. : A Shani sent you 1 item

Please can you message here or put the code here as well once done.
Once again - really appreciate your help.
Thank you