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]

Hi ashani,

Thanks, I have just downloaded the file. I will work on it when I wake up … It's 4:00 AM now in Kuwait

 

[ashani]

@mse330 - thank you
Please take a look if it's possible to have search criteria for either all and any - system should bring up whichever matches from database.
thank you once again.
sleep well

 

[mse330]

Hi ashani,

Please try the below code & let me know how it goes … I have couple of questions which I might need to adjust the code based on your feedback

1. For the candidate name, do you want an exact match or partial match ? - i.e. if you search for Smith, do you want the search to return "Will Smith" ?
2. For the available date, do you wish to search by the same month or exact date ? i.e. if the start date is 3rd of Feb 2020, and your search is 1-Feb-2020 do you want the search to return that candidate record or not? Or maybe another way would be you search for 1-Mar-2020 & search returns all candidates that are available before that date ?

Sub Search()

Dim a, b, i&, j&, Flg As Boolean
Dim CandName$, Available$, KeyStage$, Country$, Sector$, Curriculum$, Area$, Subject$

a = Sheets("Database").UsedRange.Offset(4)
ReDim b(1 To UBound(a), 1 To UBound(a, 2))

With Sheets("Search")
    CandName = .[E4]: Available = .[E5]:  KeyStage = .[E6]:  Country = .[E7]
    Sector = .[K4]:   Curriculum = .[K5]: Area = .[K6]:      Subject = .[K7]
End With

For x = 1 To UBound(a)
    If CandName <> "" Then If InStr(1, a(x, 1), CandName, 1) Then Flg = True: GoTo Nxt
    
    If Available <> "" Then If a(x, 26) = DateValue(Available) Then Flg = True: GoTo Nxt
    
    If KeyStage <> "" Then If InStr(1, Join(Array(a(x, 8), a(x, 9), a(x, 10), a(x, 11), _
        a(x, 12), a(x, 13), a(x, 14), a(x, 15)), ","), KeyStage, 1) Then Flg = True: GoTo Nxt
    
    If Country <> "" Then If InStr(1, a(x, 31), Country, 1) Then Flg = True: GoTo Nxt
    
    If Sector <> "" Then If InStr(1, Join(Array(a(x, 3), a(x, 4), a(x, 5), a(x, 6), _
        a(x, 7)), ","), Sector, 1) Then Flg = True: GoTo Nxt
        
    If Curriculum <> "" Then If InStr(1, Join(Array(a(x, 16), a(x, 17), a(x, 18), a(x, 19), _
        a(x, 20)), ","), Curriculum, 1) Then Flg = True: GoTo Nxt
        
    If Area <> "" Then If InStr(1, a(x, 30), Area, 1) Then Flg = True: GoTo Nxt
        
    If Subject <> "" Then If InStr(1, Join(Array(a(x, 21), a(x, 22), a(x, 23), a(x, 24), _
        a(x, 25)), ","), Subject, 1) Then Flg = True: GoTo Nxt
Nxt:
    If Flg = True Then
        Flg = False: i = i + 1
        For j = 1 To UBound(a, 2)
            b(i, j) = a(x, j)
        Next
    End If
Next
    
With Sheets("Search")
    .Range("A15:AG" & .UsedRange.Rows.Count).ClearContents
    If i > 0 Then .[A15].Resize(i, UBound(b, 2)) = b
End With

End Sub

 

[ashani]

Hi
Absolutely brilliant
Thank you so so much for your help. Really appreciate everything you have done.
Many thanks once again

 

[mse330]

Glad to help & thanks for the feedback … Let me know if you require any changes based on my questions in post # 13