PDA

View Full Version : [SOLVED] Vlookup or indirect,Help



b_rianv
09-25-2016, 05:32 AM
Good morning everyone,
OK guys I hope this can be done!?
If you look at my workbook I have to worksheets, one called (B_D sec11) the other (data). In workbook (B_D sec 11) I have a map, a scatter plot (x, y) chart and some tables with labels, counts and something I call a Identifier . If you click the scatter plot and then click the "Identify" button you will get numbers attached to point on the scatter plot. Now if you go to the "data" workbook these numbers are from the "index" column tagged to the (x, y) points on the chart. This index number has a column before it called "items". If you click a point on the scatter plot you will get 2 red lines going to that point on the chart.
What I am trying to figure out is how to get this or these index numbers (from the data and scatter plot chart) for that Item to go in to the cells for that item seen in the tables. So I can stop going back and forth between both worksheets and losing my position
Example
Item...............................Count.....Identifiers (these would be the number from he scatter plot chart)
Aluminum, Bearing..................... 1................. 1
Aluminum, Bottle Cap................. 3 ................8,10,11
Aluminum, Nail............... ...........2................ 2,13
Miscellaneous, House Key............1 ................15
Coins, One cent.............. ...........2................ 16,17
Coins, Quarter........................... 1................. 18
Thank you for your time
Brian

mana
09-25-2016, 06:34 AM
I misunderstand?


Option Explicit

Sub test()
Dim dic As Object
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim r As Range
Dim u As Range
Dim c As Range


Set dic = CreateObject("scripting.dictionary")
Set ws1 = Worksheets("data")
Set ws2 = Worksheets("B_D sec 11")

Set r = ws1.Range("b5", ws1.Range("B" & Rows.Count).End(xlUp))
With ws2
Set u = Union(.Range("b35:b55"), .Range("f35:f55"), .Range("j35:j55"), _
.Range("b58:b78"), .Range("f58:f78"), .Range("j58:j78"), _
.Range("b81:b102"), .Range("f81:f85"))
End With

For Each c In r
dic(c.Value) = dic(c.Value) & "," & c.Offset(, 2).Value
Next

u.Offset(, 2).ClearContents
For Each c In u
If dic.exists(c.Value) Then
c.Offset(, 2).Value = Mid(dic(c.Value), 2)
End If
Next

End Sub

b_rianv
09-25-2016, 07:05 AM
You are the best, exactly what I was looking for!!!
Now could you have it highlight the cell in the tables when I click a point in the scatter plot? As you see when I click a point in my scatter plot I have 2 red lines connecting, I would wish that the tables cell would highlight as well but can figure out that either.

mana
09-25-2016, 07:59 AM
only selection the cell instead of highlight


'Class module


Private Sub myEmbeddedChart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim lng_Element As Long
Dim lng_Argument1 As Long
Dim lng_Argument2 As Long

If Button = xlPrimaryButton Then
myEmbeddedChart.GetChartElement X, Y, lng_Element, lng_Argument1, lng_Argument2
If lng_Element = xlSeries And lng_Argument2 > 0 Then
DropLines lng_Argument2
SearchCell lng_Argument2
End If
End If


End Sub


'Standard module


Sub SearchCell(n As Long)
Dim myItem As String
Dim f As Range

myItem = Sheets("data").Cells(n + 4, "b").Value

Set f = Sheets("B_D sec 11").Cells.Find(What:=myItem, LookIn:=xlValues, LookAt:=xlPart)
If f Is Nothing Then Exit Sub
f.Activate

End Sub

b_rianv
09-25-2016, 09:11 AM
look good, what which Module should I add this too?

b_rianv
09-25-2016, 03:22 PM
I can not get the second module to work.
I am just learning VBA in school so I am lost as what to do with your code to get everything to work. I have tried everything I have learned so far and I can't get it to work.


'Class module


Private Sub myEmbeddedChart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim lng_Element As Long
Dim lng_Argument1 As Long
Dim lng_Argument2 As Long

If Button = xlPrimaryButton Then
myEmbeddedChart.GetChartElement X, Y, lng_Element, lng_Argument1, lng_Argument2
If lng_Element = xlSeries And lng_Argument2 > 0 Then
DropLines lng_Argument2
SearchCell lng_Argument2
End If
End If


End Sub


'Standard module


Sub SearchCell(n As Long)
Dim myItem As String
Dim f As Range

myItem = Sheets("data").Cells(n + 4, "b").Value

Set f = Sheets("B_D sec 11").Cells.Find(What:=myItem, LookIn:=xlValues, LookAt:=xlPart)
If f Is Nothing Then Exit Sub
f.Activate

End Sub

b_rianv
09-25-2016, 03:23 PM
Here is the workbook with your first code and it work great!!!

mana
09-26-2016, 03:45 AM
please look at "clsChartEvent" & "Module1"

b_rianv
09-26-2016, 04:03 AM
I see now, THANK YOU SO MUCH!! You are the best my friend.
Have a Great day!