Search and Results request

Jackman1

New Member
Joined
Jan 13, 2015
Messages
26
Hi

I'm trying to develop a database that will detail results based on product search, which supplier can offer that product, also listing their supplier status.

I've starting putting the suppliers within four tables to differentiate the status (Strategic, Preferred, Approved and Development) which I think is the correct way?

Also for the search criteria I have developed a formula which shortens the list based on the input value which works well (eg typing nut would list any product with "nut" in the description), please ignore the numbers in column A of the Master Data, this is used with the formula.

Is it possible to achieve the requirement from the Master Data Worksheet, which can be amended to suit options available but please note, current products is on ever growing list, currently 500+, the same for suppliers, currently 300+ all with different supplier status.

Appreciate your support, any questions please ask.
 

Attachments

  • Search and Result.jpg
    Search and Result.jpg
    236.7 KB · Views: 15

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Hello,

There is probably a formula method but with VBA, on your top row, I have entered the headings into every columns, not merged cells or centred across selection. This should allow additional companies added. i.e. C1, D1, E1 and F1 all contain "Strategic"

VBA Code:
Sub SUPPLIER()
    Application.ScreenUpdating = False
    Dim MY_PROD As Range, MY_FIND As Range
    Sheets("Sheet1").Range("B4:E10000").ClearContents
    MY_PRODUCT = Sheets("Sheet1").Range("A4").Value
    Sheets("Sheet2").Select
   
    Set MY_PROD = Sheets("Sheet2").Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
    Set MY_FIND = MY_PROD.Find(MY_PRODUCT, , xlValues, xlWhole)
   
    On Error GoTo NO_MATCH
    MY_PROD_ROW = MY_FIND.Row
    For MY_COLS = 3 To Cells(2, Columns.Count).End(xlToLeft).Column
        If UCase(Cells(MY_PROD_ROW, MY_COLS).Value) = "Y" Then
            Select Case UCase(Cells(1, MY_COLS).Value)
                Case "STRATEGIC"
                    MY_COL = "B"
                Case "PREFERRED"
                    MY_COL = "C"
                Case "APPROVED"
                    MY_COL = "D"
                Case "DEVELOPMENT"
                    MY_COL = "E"
            End Select
        With Sheets("Sheet1")
            .Range(MY_COL & .Range(MY_COL & Rows.Count).End(xlUp).Offset(1, 0).Row).Value = Sheets("Sheet2").Cells(2, MY_COLS).Value
        End With
        End If
       
    Next MY_COLS
    Sheets("Sheet1").Select
    Application.ScreenUpdating = True
    GoTo MY_END
NO_MATCH:
    MsgBox "NO ITEM FOUND", vbOKOnly, "NO MATCH"
    Sheets("Sheet1").Select
   
MY_END:
End Sub

Does this work as expected?
 
Upvote 0

Forum statistics

Threads
1,214,428
Messages
6,119,420
Members
448,895
Latest member
omarahmed1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top