Lookup value and show all corresponding values in one cell

C

charleymax

New Member
Joined
Sep 10, 2010
Messages
39
Hi all,

Many apologies if this is easy but I seem to have struggled with it for hrs now...

I have a data set where I want to have a column that looks up a document number and shows me in one cell all the project numbers it is linked to...
If the document only shows up once for one project I want it to state None...

So A1 looks up C1's value i.e. Doc 1234 and sees that through all of Col B it is listed as involved in the MSG, PPP and ZyD projects... So in A it would return MSG, PPP,ZyD...

Want it to look like this
oqzjip.jpg
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG03Mar25
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q, K
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C2"), Range("c" & rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 2)
        [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.value) [COLOR="Navy"]Then[/COLOR]
            n = n + 1
            .Add Dn.value, Array(n, Dn.Offset(, -1), Dn.Offset(, -2).Address)
        [COLOR="Navy"]Else[/COLOR]
            Q = .Item(Dn.value)
            Q(1) = Q(1) & ", " & Dn.Offset(, -1)
            Q(2) = Q(2) & ", " & Dn.Offset(, -2).Address
            .Item(Dn.value) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
[COLOR="Navy"]Set[/COLOR] Rng = Range(.Item(K)(2))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Rng
        R = IIf(InStr(.Item(K)(1), ",") > 1, .Item(K)(1), "None")
    [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi MickG,

Thanks a million... I just need a few pointer on where to put the code and how to call it in the cells I want the crossover list to appear...?
I have put it in the view code section of the tab I'm working in.
When I change the Doc # in a cell it recalculates but I'm not seeing anything being updated...

Also my Doc# column is actualy col J and There may be one or two columns between, so projects in E and crossover in B... Do I just need to edit the Range and Dn.offsets to -5 or -8 etc..

Code: 
Sub MG03Mar25()
Dim Rng As Range, Dn As Range
Dim n As Long
Dim Q, K
Dim R As Range
Set Rng = Range(Range("J2"), Range("j" & Rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 2)
        With CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
    For Each Dn In Rng
        If Not .Exists(Dn.Value) Then
            n = n + 1
            .Add Dn.Value, Array(n, Dn.Offset(, -5), Dn.Offset(, -8).Address)
        Else
            Q = .Item(Dn.Value)
            Q(1) = Q(1) & ", " & Dn.Offset(, -5)
            Q(2) = Q(2) & ", " & Dn.Offset(, -8).Address
            .Item(Dn.Value) = Q
        End If
    Next
For Each K In .keys
Set Rng = Range(.Item(K)(2))
    For Each R In Rng
        R = IIf(InStr(.Item(K)(1), ",") > 1, .Item(K)(1), "None")
    Next R
Next K
End Sub

23rvi1x.jpg
 
Last edited:
Upvote 0
Ok, I got it to work if I put it in the Worksheet_Change(ByVal Target As Range)

Works a beauty but Problem is eventually it comes up with a Run Time error 1004 'Out of Stack Space'

Is there any way of simplifying the calculation so I can run a full calculation first time or now and again through calling a full macro but have a simpler worksheet_change version that only recalculates for rows where the Doc # is the same as the one I just updated... if that is doable...

Apologies for complicating things! :eeek:
 
Upvote 0
Hi, Your probably got this, but just to recap.
This is a double click event for "A1" (Docs =Column"J", Projects=Column "E", CrossOver=Column"B")
Right click sheet tab , Select "View Code", VB window appears.
Paste code into VB Window, Close VB window.
To run Code , Double Click "A1.

Ref your short Macro Idea.
Do you mean you enter another doc number in Column "J" along with its related inf in the same row, then you run the New (Short) Code, which will only update information for that number.
Please confirm, or clarify.
Code: 
[COLOR=navy]Sub[/COLOR] MG04Mar03
Private [COLOR=navy]Sub[/COLOR] Worksheet_BeforeDoubleClick(ByVal Target [COLOR=navy]As[/COLOR] Range, Cancel [COLOR=navy]As[/COLOR] Boolean)
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Q, K
[COLOR=navy]Dim[/COLOR] R [COLOR=navy]As[/COLOR] Range
[COLOR=navy]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR=navy]Then[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("J2"), Range("J" & rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 2)
        [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        [COLOR=navy]If[/COLOR] Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
            n = n + 1
            .Add Dn.value, Array(n, Dn.Offset(, -5), Dn.Offset(, -8).Address)
        [COLOR=navy]Else[/COLOR]
            Q = .Item(Dn.value)
            Q(1) = Q(1) & ", " & Dn.Offset(, -5)
            Q(2) = Q(2) & ", " & Dn.Offset(, -8).Address
            .Item(Dn.value) = Q
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR]
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
[COLOR=navy]Set[/COLOR] Rng = Range(.Item(K)(2))
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Rng
        R = IIf(InStr(.Item(K)(1), ",") > 0, .Item(K)(1), "None")
    [COLOR=navy]Next[/COLOR] R
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
Please Note:-
The first line of code "Sub MG04Mar03" , should not be there, please remove before installing, Sorry.
Mick
 
Upvote 0
Hey Mick... :oops:

ok... This looks like a great solution and should kill that stack overload error I was getting. Problem is now I'm seeing another runtime error 1004... This time it says:
Method 'Range' of Object '_Worksheet' failed...

debug stops on this line...
Code: 
Set Rng = Range(.Item(K)(2))

30s810g.jpg
 
Upvote 0
Can you post the data it failed on.
Also If you Place a Border around each cell in the range you wish to post , so that it forms a grid, then Copy and paste to the forum, I will be able to copy this to my sheet.
If you paste a Picture I can't copy it.
Regards Mick
 
Upvote 0
MickG said:
Can you post the data it failed on.
Also If you Place a Border around each cell in the range you wish to post , so that it forms a grid, then Copy and paste to the forum, I will be able to copy this to my sheet.
If you paste a Picture I can't copy it.
Regards Mick
Click to expand...


Hi Mick,

You peaked my curiosity on what it might fail on... it was blanks. This couldn't handle blans in Colm J... can the VBA be amended to ignore blanks in Column J.?

So what I'm saying is it works perfectly if I start fresh with just 20 or 30 rows... Also When I deleted any with blanks in J it still worked even with over 1000 rows...
 
Upvote 0
Try this:-
Funnily enough when I placed Blank rows in "J" in did not fail it just returned "," which I would have expect.
This is written in Excel 2003, What are you ???

Code: 
Private [COLOR=navy]Sub[/COLOR] Worksheet_BeforeDoubleClick(ByVal Target [COLOR=navy]As[/COLOR] Range, Cancel [COLOR=navy]As[/COLOR] Boolean)
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Q, K
[COLOR=navy]Dim[/COLOR] R [COLOR=navy]As[/COLOR] Range
[COLOR=navy]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR=navy]Then[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("J2"), Range("J" & rows.Count).End(xlUp))
    ReDim ray(1 To Rng.Count, 1 To 2)
        [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
        [COLOR=navy]If[/COLOR] Dn <> "" [COLOR=navy]Then[/COLOR]
        [COLOR=navy]If[/COLOR] Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
            n = n + 1
            .Add Dn.value, Array(n, Dn.Offset(, -5), Dn.Offset(, -8).Address)
        [COLOR=navy]Else[/COLOR]
            Q = .Item(Dn.value)
            Q(1) = Q(1) & ", " & Dn.Offset(, -5)
            Q(2) = Q(2) & ", " & Dn.Offset(, -8).Address
            .Item(Dn.value) = Q
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR]
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
[COLOR=navy]Set[/COLOR] Rng = Range(.Item(K)(2))
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] Rng
        R = IIf(InStr(.Item(K)(1), ",") > 0, .Item(K)(1), "None")
    [COLOR=navy]Next[/COLOR] R
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]If[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Locate Cell and enter corresponding value into new cell
Replies
3
Views
74
myall_blues
myall_blues
Q
  • Question Question
Show Decimals until first non-zero decimal is shown
2
Replies
13
Views
309
myall_blues
myall_blues
B
  • Question Question
Excel Table Lookup with OR Conditions and Multiple Columns
Replies
1
Views
128
BenW71
B
B
  • Question Question
Sum child cells and allow reference to higher cell within Table
Replies
7
Views
153
babyjwhale
B
H
  • Question Question
Using XLOOKUP in VBA to lookup value underneath specific header name (columns can change depending on worksheet)
Replies
0
Views
164
Hailee994
H

Forum statistics

Threads
1,224,616
Messages
6,179,909
Members
452,949
Latest member
beartooth91

Share this page

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