Lookup a value from database and get the list of matching values to another sheet

Question

I want to find the corresponding Disc Codes from a list and copy them in the DiscName column in the summary sheet. some lab names will have more than one Disc codes so when I run the macro it should bring up all the relevant Disc Codes matching with the Lab name to DiscName column. Any help will be greatly appreciated. Not sure if I can upload the image of the summary sheet but i looks like this.

Col 1                col 2     col 3
Lab name             Disc Name
(say abcd)           xxxx
                     yyyy
                     zzzz
                     pppp

and the list looks something like this.

Col 1          Col 2
Lab name       Disc name
abcd            xxxxx
abcd            yyyyy
abcd            zzzzz
abcd            ppppp
bcda            qqqqq
bcda            rrrrr
bcda            iiiii
bcda            jjjjj
bcda            kkkkk

I just re arranged the table so it looks more clearer. Hope this helps to understand my query better. Thanks again for any help.

I tried this code but I cannot get it to write the next Disc name in the next row after under Disc name in the summary sheet. It repeats the same Disc name as the first one. Ideally it should continue to fill in the Summary sheet with all the relevant Disc Names appearing agianst the Lab name in the list.

Sub Vlooker()

Dim FindString As String Dim Rng As Range Dim fcomp For Each fcomp In Sheets("cont").Range("p3") ' range of Source Comparison

FindString = fcomp


    With Sheets("list").Range("q2:q106") 'range of cells to search
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(1), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False)

        If Rng Is Nothing Then



        Else
        Do While fcomp = FindString
          fcomp.Offset(0, 1).Value = Rng.Offset(0, 1)
          fcomp.Offset(1, 1).Value = Rng.Offset(0, 1) 
          Loop

        End If
    End With

Next fcomp

End Sub

This is what I want to happen real symple terms.

Go to List, Check A2. 
If list A2 matches with Summary A2 then 
go to summary b2
make summary b2 value = to list b2 value
then chekc next row in list
if found match with summary a2 then
go to summary, last actioned cell, go one row down and make value = to the value in column b in  list against the matching cell
Repeat this process till all matches found for summary a2.
Start this process when ever value of summay a2 changes.

I suspect you need to use VLOOKUP(), but your question isn't clear because the formatting didn't come through. Put four spaces in front of each example row to allow the formatting to show as code, or else put a screenshot of your sheet. — NYCdotNet
@NYCdotNet I just edited my post as you suggested. Hope it is more clear now.. Thnks.. — user2802915
If you need to account for multiple matches, it might be best-served using the range .Find method in a loop. Or you could use the range .AutoFilter method on the list sheet, and then iterate over the visible cells (SpecialCells(xlCellTypeVisible))? Or you could just build an array in memory and print/transpose that out to the worksheet? There's several ways to approach this problem. What have you tried so far? — David Zemens

NYCdotNet NYCdotNet · Accepted Answer · 2013-09-21T23:44:15

This function will do something similar to what you're asking for. Place the code in a new module in the VBA editor.

Make sure your second tab is called "Mappings" (or change the code). This tab should have two columns just as you identified in your question.

Then just set cell B2 to the formula =DisciplineLookup(B1) and you should see the looked-up data. Note that you will also have to edit the formatting for column B to "Wrap Text" on the alignment tab.

I don't think this is exactly what you were looking for, but it may solve your problem. If this doesn't work, you might want to investigate creating a new tab with a macro that clears it and outputs a report when run.

Note that you may have to hit CTRL+ALT+F9 to forcefully recalculate everything if you update the base data even if you have auto-calculations enabled.

Function DisciplineLookup(TheLabName As String) As String

    Dim objSheet As Worksheet, intUsedRows As Integer
    Set objSheet = Sheets("Mappings")
    intUsedRows = objSheet.UsedRange.Rows.Count

    'Get all of the relevant data into a VBA array.
    Dim objData() As Variant
    objData = objSheet.Range("A2", "B" & CStr(intUsedRows)).Value
    Dim objDisciplines As New Collection


    'Find rows matching the passed parameter, and add them to a collection
    Dim intI As Integer
    For intI = 1 To intUsedRows - 1
        If objData(intI, 1) = TheLabName Then
            objDisciplines.Add objData(intI, 2)
        End If
    Next

    'Format the collection into a new concatenated string
    'Note this may be really slow if you have a lot of data
    ' If so, look into using an array and the JOIN function
    Dim strDisciplines As String, strDiscipline As Variant
    strDisciplines = ""
    For Each strDiscipline In objDisciplines
        strDisciplines = strDisciplines & CStr(strDiscipline) & vbCrLf
    Next

    'trim trailing CRLF
    If Len(strDisciplines) > 0 Then
        strDisciplines = Left(strDisciplines, Len(strDisciplines) - 2)
    End If

    DisciplineLookup = strDisciplines

End Function

Lookup a value from database and get the list of matching values to another sheet

1 Answers