Lookup in more than one table

Closed
Report
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
Hello,
I have a worksheet that contains 3 tables
Each table consists of 2 columns

A B
Name Code
AAA 300
BBB 301
CCC 302

D E
Name Code
XXX 303
YYY 304
ZZZ 305

G H
Date Code
1/1/2010 300
2/2/2010 301
3/3/2010 305
4/4/2010 300
5/5/2010 304+305
6/6/2010 301
7/7/2010 300

what i want to do is that when i enter a code (let's say 300) in the cell J1, then in cells K1:K... appear the dates corresponding to the codes 300,301 & 302.
and if i enter 304, then in cells K1:K... appear the dates corresponding to the codes 303,304 & 305 ( taking into account that "304" is a part of "304+305" in the column H).

Is that possible ?
Thanks

1 reply

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
Assumptions
1. The look value would be typed in J2 (in question it says J1, correct code if it is to be j1)

2. the result would start from cells K2 (in question it says K1, correct code if it is to be k1)

3. If J2 is cleared, all values from k2 down is to be cleared.

4. If value is entered in J2,. previous values in k2 and down should be cleared


Steps
1. Open VBE ( ALT + F11)
2. In the VBE environment, double click on the sheet where the data will reside
3. Paste the code below


Private Sub Worksheet_Change(ByVal Target As Range)

Dim sReadValue As String
Dim iCode As Integer
Dim lMaxRows As Long
Dim lRow As Long
Dim sTemp As String
Dim vPos As Variant
Dim lResultRow As Long

    ' if value is not entered in J2, then nothing to be done
    If Target.Address <> "$J$2" Then Exit Sub
    
    Application.EnableEvents = False
    
    'clear all previous values in cells K2 and below
    Range(Cells(2, "K"), Cells(Rows.Count, "K")).ClearContents
    
    If Range("J2") = "" Then GoTo Exit_Sub
    
    
    Application.EnableEvents = False
    
    'code will be found in J2
    iCode = Range("J2")
    
    lMaxRows = Cells(Rows.Count, "G").End(xlUp).Row
    
    ' result of find is to be displayed from row 2 and down
    lResultRow = 2
    
    For lRow = 2 To lMaxRows
    
        sReadValue = Cells(lRow, "H")
        
        If (Not (InStr(1, sReadValue, iCode) > 0)) Then GoTo Next_lRow
        
        vPos = InStr(1, sReadValue, "+")
        
        Do While (vPos > 0)
        
            sTemp = "|" & Trim(Left(sReadValue, vPos - 1)) & "|"
            
            sReadValue = Trim(Mid(sReadValue, vPos + 1))
            
            vPos = InStr(1, sReadValue, "+")
        
        Loop
        
        If (sReadValue <> "") Then
            sTemp = sTemp & "|" & sReadValue & "|"
        End If
        
        
        If (InStr(1, sTemp, "|" & iCode & "|") > 0) Then
             Cells(lResultRow, "K") = Cells(lRow, "G").Text
             lResultRow = lResultRow + 1
        End If
        
Next_lRow:

    Next lRow
    
Exit_Sub:
    Application.EnableEvents = True
    
End Sub