Search in a Cell and Return Associate Value

kparadise

Board Regular
Joined
Aug 13, 2015
Messages
186
Hello,

I have two tabs. [TAB1] is where I want to place my results. I want the results starting in columns C and moving right, as many columns as need be. I am hoping I can limit the columns the results section will be by only returning unique results (i.e. if there are three reference IDs that are "Red", I only want to return "Red" one time - if this cannot be done, that is ok too).

So, what I am trying to do is to look into each cell in column A on [TAB1], and search for the values in [TAB2] Column A; and then return values from [TAB2] Column B into [TAB1] Column C. Each record in [TAB1] can have multiple values, special characters, return signs, etc.



[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"]TAB1
[/TD]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[TD="align: center"]C
[/TD]
[TD="align: center"]D
[/TD]
[TD="align: center"]E
[/TD]
[TD="align: center"]F
[/TD]
[/TR]
[TR]
[TD="align: center"]1
[/TD]
[TD="align: center"]REF
[/TD]
[TD="align: center"]ID
[/TD]
[TD="align: center"]Results
[/TD]
[TD="align: center"]Results
[/TD]
[TD="align: center"]Results
[/TD]
[TD="align: center"]Results
[/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD]~LL_123 - this is a test
~LL_125 - this is also a test
[/TD]
[TD]A1
[/TD]
[TD]Red
[/TD]
[TD]Blue
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"]3
[/TD]
[TD]~LL_9999 - testing testing
[/TD]
[TD]A2
[/TD]
[TD]Yellow
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"]4
[/TD]
[TD]~LL_9999 - testing testing
~LL_123 - this is a test
~LL_124 - hello testing
~LL_315 - can you hear me
[/TD]
[TD]A3
[/TD]
[TD]Yellow
[/TD]
[TD]Red
[/TD]
[TD]Blue
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"]5
[/TD]
[TD]~LL_123 - this is a test
~LL_2362 - yikes
~LL_9998 - test please
[/TD]
[TD]A4
[/TD]
[TD]Red
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"]6
[/TD]
[TD]~LL_5555
[/TD]
[TD]A5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"]TAB2
[/TD]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[/TR]
[TR]
[TD="align: center"]1
[/TD]
[TD="align: center"]REF
[/TD]
[TD="align: center"]VALUE
[/TD]
[/TR]
[TR]
[TD="align: center"]2
[/TD]
[TD]LL_123
[/TD]
[TD]Red
[/TD]
[/TR]
[TR]
[TD="align: center"]3
[/TD]
[TD]LL_124
[/TD]
[TD]Blue
[/TD]
[/TR]
[TR]
[TD="align: center"]4
[/TD]
[TD]LL_125
[/TD]
[TD]Blue
[/TD]
[/TR]
[TR]
[TD="align: center"]5
[/TD]
[TD]LL_2094
[/TD]
[TD]Green
[/TD]
[/TR]
[TR]
[TD="align: center"]6
[/TD]
[TD]LL_2363
[/TD]
[TD]Red
[/TD]
[/TR]
[TR]
[TD="align: center"]7
[/TD]
[TD]LL_315
[/TD]
[TD]Blue
[/TD]
[/TR]
[TR]
[TD="align: center"]8
[/TD]
[TD]LL_9999
[/TD]
[TD]Yellow
[/TD]
[/TR]
[TR]
[TD="align: center"]9
[/TD]
[TD]LL_9998
[/TD]
[TD]Red
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Here's what I came up with based on your example data:

Code:
Sub SearchAndReturn()
    Dim Tab1RefRange As Range, Tab2RefRange As Range
    Dim Tab1RefArray As Variant, Tab1ResultsArray() As Variant
    Dim Tab2Array As Variant, i As Long, j As Long, k As Long, m As Integer
    Dim ResultsExists As Boolean
    
    With Worksheets("TAB1")
        If .Range("A2").Value <> "" Then
            Set Tab1RefRange = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
        Else
            MsgBox "TAB1 cell A2 is empty."
            Exit Sub
        End If
    End With
    
    With Worksheets("TAB2")
        If .Range("A2").Value <> "" Then
            Set Tab2RefRange = .Range("A2", .Cells(.Rows.Count, 2).End(xlUp))
        Else
            MsgBox "TAB2 cell A2 is empty."
            Exit Sub
        End If
    End With
    
    Tab1RefArray = Tab1RefRange.Value
    Tab2Array = Tab2RefRange.Value
    
    For i = 1 To UBound(Tab1RefArray, 1)
        k = 0
        For j = 1 To UBound(Tab2Array, 1)
            If InStr(1, Tab1RefArray(i, 1), Tab2Array(j, 1)) > 0 Then
                If k = 0 Then
                    k = 1
                    ReDim Tab1ResultsArray(1 To 1, 1 To k)
                    Tab1ResultsArray(1, k) = Tab2Array(j, 2)
                Else
                    ResultsExists = False
                    For m = 1 To k
                        If Tab1ResultsArray(1, m) = Tab2Array(j, 2) Then
                            ResultsExists = True
                            Exit For
                        End If
                    Next m
                    If Not ResultsExists Then
                        k = k + 1
                        ReDim Preserve Tab1ResultsArray(1 To 1, 1 To k)
                        Tab1ResultsArray(1, k) = Tab2Array(j, 2)
                    End If
                End If
            End If
        Next j
        If k > 0 Then
            Tab1RefRange.Cells(i, 1).Offset(0, 2).Resize(1, k).Value = Tab1ResultsArray
        End If
    Next i
End Sub
 
Upvote 0
This works great, I am just having trouble implementing it to my actual spreadsheet.

1. Can you adjust the code a bit to the following. Can we search for the header named "REF" in Tab1; because this is an adhoc report, and it might not always be in column A on TAB1....it could be column A-ZZ.
2. Can you start the results after the last column in TAB1. Because this is an adhoc report, sometimes TAB1 will have 4 columns, sometimes it will have 30 columns...I just want the results to start after the last column with a header.
 
Upvote 0
Sure. Here is what I came up with. Note that it creates new results columns and doesn't delete any previous ones. So, if you run this twice, you'll get two sets of results columns side-by-side.

Code:
Sub SearchAndReturn()
    Dim Tab1RefRange As Range, Tab2RefRange As Range, Tab1ResultsRange As Range
    Dim Tab1RefArray As Variant, Tab1ResultsArray() As Variant
    Dim Tab2Array As Variant, i As Long, j As Long, k As Long, m As Integer
    Dim ResultsExists As Boolean, iResults As Integer
    
    With Worksheets("TAB1")
        Set Tab1RefRange = FindREF(.UsedRange, "REF")
        If Tab1RefRange Is Nothing Then
            MsgBox "Can't find 'REF' column on TAB1."
            Exit Sub
        End If
        Set Tab1ResultsRange = .Cells(Tab1RefRange.Row, .Columns.Count).End(xlToLeft).Offset(0, 1)
        Set Tab1RefRange = .Range(Tab1RefRange.Offset(1, 0), _
           Tab1RefRange.Offset(.Rows.Count - Tab1RefRange.Row, 0).End(xlUp))
        Tab1RefArray = Tab1RefRange.Value
    End With
    
    With Worksheets("TAB2")
        Set Tab2RefRange = FindREF(.UsedRange, "REF")
        If Tab2RefRange Is Nothing Then
            MsgBox "Can't find 'REF' column on TAB2."
            Exit Sub
        End If
        Tab2Array = .Range(Tab2RefRange.Offset(1, 0), _
           Tab2RefRange.Offset(.Rows.Count - Tab2RefRange.Row, 1).End(xlUp))
    End With
        
    For i = 1 To UBound(Tab1RefArray, 1)
        k = 0
        For j = 1 To UBound(Tab2Array, 1)
            If InStr(1, Tab1RefArray(i, 1), Tab2Array(j, 1)) > 0 Then
                If k = 0 Then
                    k = 1
                    ReDim Tab1ResultsArray(1 To 1, 1 To k)
                    Tab1ResultsArray(1, k) = Tab2Array(j, 2)
                Else
                    ResultsExists = False
                    For m = 1 To k
                        If Tab1ResultsArray(1, m) = Tab2Array(j, 2) Then
                            ResultsExists = True
                            Exit For
                        End If
                    Next m
                    If Not ResultsExists Then
                        k = k + 1
                        ReDim Preserve Tab1ResultsArray(1 To 1, 1 To k)
                        Tab1ResultsArray(1, k) = Tab2Array(j, 2)
                    End If
                End If
            End If
        Next j
        If k > 0 Then
            If k > iResults Then iResults = k
            Worksheets("TAB1").Cells(Tab1RefRange.Cells(i, 1).Row, Tab1ResultsRange.Column).Resize(1, k).Value = Tab1ResultsArray
        End If
    Next i
    If iResults > 0 Then
        Tab1ResultsRange.Resize(1, iResults).Value = "Results"
    End If
End Sub

Function FindREF(SearchRange As Range, Text As String) As Range
    Dim FoundCell As Range
    Dim LastCell As Range
    Dim FirstAddr As String
    With SearchRange
        Set LastCell = .Cells(.Cells.Count)
    End With
    Set FoundCell = SearchRange.Find(what:=Text, after:=LastCell, lookat:=xlWhole)


    If Not FoundCell Is Nothing Then
        Set FindREF = FoundCell
    End If
End Function
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,187
Members
452,616
Latest member
intern444

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