Search multiple criteria options w/ vlookup + Bonus

[Jugg8]

Hello,

I would like to create a lookup tool for various people in my company - where they can check the status of an invoice.

Here is an example of the data that will be stored in a separate excel spreadsheet called 'Invoice Data' (for example).

The user will open a separate look-up excel spreadsheet named 'Lookup tool' stored in the same drive. The user will have three options to search - by invoice # (one or multiple), Client # or Sales Person. They will enter the details and click the 'Search' button'.

Here is an example of them searching one invoice # (will have up to 20 cells to lookup):

Her is an example if they searched by multiple invoice #s:

Here is an example if they searched by company:

Here is an example of them searching by Salesman:

I would assume, they would only be allowed to choose one of the fields - as choosing an invoice and client # that don't match would cause an error. So if the user chose two criteria the search wouldn't work.

***BONUS***

If the user had the ability to check the invoices they wanted further info on, they could check box the invoices and click 'email' which will send a generic email to our team asking for 'further info on the following'....which would then list the invoice numbers they have checked off (if it could all fields...perfect). If it could only pull the invoice # and Jr Sales person that would be great!.

Any help on this would be awesome!

thanks
Jugg8

 

[fadee2]

Hi Jugg,

Welcome to the board.

The user will open a separate look-up excel spreadsheet named 'Lookup tool' stored in the same drive.

I would suggest creating a link between your master data file and your lookup file, in a sense that once the lookup file loads up it should bring in all the data from your master file. This way it is much easier and faster to perform the lookup.

Having said that, try following codes to perform single and/or multilayer lookups, uptil the bonus part, as mentioned in your post.

Note: Place all of the below in a single standard module and bind your search button with procedure "perform".....

Sub single_inv()        'autofilter on a single invoice
Dim rng As Range
Set rng = Range("table1").ListObject.DataBodyRange

With Sheets("data")
    .Activate
    rng.AutoFilter Field:=6, Criteria1:=Sheets("search").Range("b4")
End With
End Sub
'========================================================================

Sub multiple_inv()      'autofilter on a multiple invoices
Dim ms_rng As Range
Dim fl_rng As Range
Dim temparray As Variant
Dim mycriteria() As String


Set ms_rng = Range("table1").ListObject.DataBodyRange   'master range
  
fl_lr = Sheets("search").Cells(Rows.Count, 2).End(xlUp).Row     'lastrow in lookupvalue range

Sheets("search").Activate
temparray = Sheets("search").Range(Cells(4, 2), Cells(fl_lr, 2)).Value  'temp array with lookup values

ReDim mycriteria(1 To UBound(temparray))

For i = 1 To UBound(temparray)
    mycriteria(i) = temparray(i, 1)
Next

Sheets("data").Activate
With Sheets("data")
  
    ms_rng.AutoFilter Field:=6, Criteria1:=mycriteria, Operator:=xlFilterValues
End With

End Sub

'========================================================================

Sub single_com()           'autofilter on a single Company
Dim rng As Range
Set rng = Range("table1").ListObject.DataBodyRange


With Sheets("data")
  
    rng.AutoFilter Field:=2, Criteria1:=Sheets("search").Range("d4")
End With
End Sub

'========================================================================

Sub salesman()              'autofilter on a single salesman
Dim rng As Range
Set rng = Range("table1").ListObject.DataBodyRange


With Sheets("data")
  
    rng.AutoFilter Field:=11, Criteria1:=Sheets("search").Range("d7")
End With
End Sub

'========================================================================

Sub perform()               'perform autofilter to select data based on criteria set on search sheet
Dim cb As CheckBox
For Each cb In ActiveSheet.CheckBoxes
    If cb.Value = xlOn Then cb.Value = xlOff
Next cb

Application.ScreenUpdating = False
lr = Sheets("search").Cells(Rows.Count, 2).End(xlUp).Row

Range("TABLE1").ListObject.DataBodyRange.AutoFilter

With Sheets("search")
On Error Resume Next
    s = Sheets("search").Range("inv").SpecialCells(xlCellTypeConstants).Count
        If s > 1 Then
            If .Range("d4") <> "" Then MsgBox "Searching Multiple Invoices, Client Name will exempted from search", vbInformation
            If .Range("d7") <> "" Then MsgBox "Searching Multiple Invoices, Salesman Name will exempted from search", vbInformation
          
            Range("table1").ListObject.DataBodyRange.AutoFilter
            multiple_inv
            results
        ElseIf s = 1 And .Range("D4") = "" And .Range("d7") = "" Then
                Range("table1").ListObject.DataBodyRange.AutoFilter
                single_inv
                results
            ElseIf s = 1 And .Range("d4") <> "" And .Range("d7") = "" Then
                    Range("table1").ListObject.DataBodyRange.AutoFilter
                    single_inv
                    single_com
                    results
                ElseIf s = 1 And .Range("d4") = "" And .Range("d7") <> "" Then
                        Range("table1").ListObject.DataBodyRange.AutoFilter
                        single_inv
                        salesman
                        results
                    ElseIf s = 1 And .Range("d4") <> "" And .Range("d7") <> "" Then
                        MsgBox "Please remove either Client or Salesman from search Criteria", vbCritical
                        ElseIf s = "" And .Range("d4") <> "" And .Range("d7") = "" Then
                            Range("table1").ListObject.DataBodyRange.AutoFilter
                            single_com
                            results
                            ElseIf s = "" And .Range("d4") = "" And .Range("d7") <> "" Then
                                Range("table1").ListObject.DataBodyRange.AutoFilter
                                salesman
                                results
        End If
Sheets("search").Activate
End With

Application.ScreenUpdating = True
Exit Sub

End Sub

'========================================================================

Sub results()               'fetching the results
Dim r1, r2, r3, r4, r5, r6, r7, r8, r9
Dim myrng As Range

If Sheets("data").ListObjects("table1").Range.Columns(1).SpecialCells(xlCellTypeVisible).Count < 2 Then
    MsgBox "No data to reflect"
    Exit Sub
End If

With Sheets("search")
    srch_lr = .Cells(Rows.Count, 8).End(xlUp).Row
    If srch_lr > 3 Then
    .Range(.Cells(4, 8), .Cells(srch_lr, 16)).ClearContents
    .Range(.Cells(4, 8), .Cells(srch_lr, 15)).ClearFormats
    End If
End With

On Error Resume Next
Set r1 = Range("table1").ListObject.ListColumns(6).DataBodyRange.SpecialCells(xlCellTypeVisible)
Set r2 = Range("table1").ListObject.ListColumns(7).DataBodyRange.SpecialCells(xlCellTypeVisible)
Set r3 = Range("table1").ListObject.ListColumns(8).DataBodyRange.SpecialCells(xlCellTypeVisible)
Set r4 = Range("table1").ListObject.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)
Set r5 = Range("table1").ListObject.ListColumns(3).DataBodyRange.SpecialCells(xlCellTypeVisible)
Set r6 = Range("table1").ListObject.ListColumns(5).DataBodyRange.SpecialCells(xlCellTypeVisible)
Set r7 = Range("table1").ListObject.ListColumns(11).DataBodyRange.SpecialCells(xlCellTypeVisible)
Set r8 = Range("table1").ListObject.ListColumns(10).DataBodyRange.SpecialCells(xlCellTypeVisible)
Set r9 = Range("table1").ListObject.ListColumns(12).DataBodyRange.SpecialCells(xlCellTypeVisible)

'Invoice #   Inv Date    Inv Amount  Client  Client #    Salesman    Js Sales    Status Date Status

srch_lr = Sheets("search").Cells(Rows.Count, 8).End(xlUp).Row

r1.Copy
Sheets("search").Range("h4").PasteSpecial Paste:=xlPasteValues

r2.Copy
Sheets("search").Range("i4").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("search").Range("i:i").EntireColumn.AutoFit

r3.Copy
Sheets("search").Range("j4").PasteSpecial Paste:=xlPasteValues

r4.Copy
Sheets("search").Range("k4").PasteSpecial Paste:=xlPasteValues
Sheets("search").Range("k:k").EntireColumn.AutoFit

r5.Copy
Sheets("search").Range("l4").PasteSpecial Paste:=xlPasteValues

r6.Copy
Sheets("search").Range("m4").PasteSpecial Paste:=xlPasteValues

r7.Copy
Sheets("search").Range("n4").PasteSpecial Paste:=xlPasteValues

r8.Copy
Sheets("search").Range("p4").PasteSpecial Paste:=xlPasteValues

r9.Copy
Sheets("search").Range("o4").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("search").Range("o:o").EntireColumn.AutoFit

Application.CutCopyMode = xlCopy

Range("table1").ListObject.DataBodyRange.AutoFilter
End Sub

'========================================================================

Sub active_rows()               'select rows with activated checkboxes
Dim cb As CheckBox

With Sheets("emaildata")
    .Activate
    .Range("A1").Select
    .Range(Selection, Selection.End(xlToRight)).Select
    .Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete
End With

Sheets("search").Activate
Sheets("search").Range(Cells(3, 8), Cells(3, 16)).Copy Sheets("emaildata").Range("a1")

For Each cb In ActiveSheet.CheckBoxes
    lr = Sheets("emaildata").Cells(Rows.Count, 1).End(xlUp).Row
    If Sheets("emaildata").Cells(lr, 1) = "" Then
        lr = 1
    Else
        lr = lr + 1
    End If
  
    If cb.Value = xlOn Then

         s = Range(Range(cb.LinkedCell).Address).Row

        Sheets("search").Range(Cells(s, 8), Cells(s, 16)).Select

        Selection.Copy
        Sheets("emaildata").Cells(lr, 1).PasteSpecial
    
        Application.CutCopyMode = False
       
    End If
Next cb
With Sheets("emaildata")
    .Activate
    .Range("A1").Select
    .Range(Selection, Selection.End(xlToRight)).Select
    .Range(Selection, Selection.End(xlDown)).Select
End With
End Sub

As for the bonus part, have a look at this. this is a complete guide to paste a selected range in message body of outlook message.

I have also attached the worksheet for convenience.

Also, try uploading a sample data file rather then screen captures, that makes it easier for everyone to provided solutions rather than making their own data or replicating your data through typing.

hth....

 

[Jugg8]

This is amazing! Thanks very much @fadee2. This has worked like a charm.

I have a few questions:

1. You mentioned "creating a link between your master data file and your lookup file, in a sense that once the lookup file loads up it should bring in all the data from your master file". So what I've done in the data tab is link each cell to my data file e.g. A1 (data tab) = A1 (data file, A2 (data tab) ....the issue is, the data either doesn't update or doesn't even populate unless the data file is opened. This will cause issues as the users won't have access to the data file so cannot open it. Can you advise if I'm 'linking' the two files correctly? Here is the example.
2. When I click 'search' and the data pulls in, there are odd times where the data will come in formatted and clear the formatting of the user tab....is there a way to make sure only text gets retrieved without formatting?

And I have noted re uploading a sample data file.

thanks,
Jugg8

 

[fadee2]

You are very welcome.....

You mentioned "creating a link between your master data file and your lookup file, in a sense that once the lookup file loads up it should bring in all the data from your master file". So what I've done in the data tab is link each cell to my data file e.g. A1 (data tab) = A1 (data file, A2 (data tab) ....the issue is, the data either doesn't update or doesn't even populate unless the data file is opened. This will cause issues as the users won't have access to the data file so cannot open it. Can you advise if I'm 'linking' the two files correctly? Here is the example.

I meant, to link them via data tab in the ribbon. Assuming your master data is residing in a worksheet on your network drive, then create a data connection to your master file using Data > Get & Transform > New Query > From File > From Workbook

and importing your master data in a worksheet in your lookup workbook. and then use VBA to automate connection refresh

ThisWorkbook.RefreshAll

under workbook open event. This way, once the user opens up lookup file, the file will automatically refresh data connection and will bring in updated data for users to review.

hth....

 

[Jugg8]

Thanks very much @fadee2 . This worked like a charm.

 

[fadee2]

You are very welcome... and thanks for the feedback...