Lookup in more than one table

Closed
Tornado1981 - Apr 2, 2010 at 05:07 PM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Apr 5, 2010 at 11:45 PM
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 response

rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Apr 5, 2010 at 11:45 PM
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