Return All Matches and Then Move to Next?

[bkrupa]

Hi,

I have been racking my brain with this for days now trying different things but keep ending up with circular references when I think I am close - I do not think there is anyway to do this without VBA if it is even possible with VBA as I haven't found anything close in searching.


In the first sheet I have a list of product family names that repeat up to 50 times in rows but each row has a unique code next to the family name in another column. This goes on for about 2000 rows.

IE:
Houses | 5656
Houses | 6581
Houses | 6568
Houses | 7878
Houses | 9654
Trucks |6655
Trucks | 5656
Trucks | 6363
Trucks | 2236

On another sheet I would like to be able to type a family name in column A row 1 and in column B row 1 have all up to 50 unique codes for that family name returned (there isn't always the same number of entries).

IE:
Houses |5656
...........| 6581
...........| 6568
...........| 7878

Then if I type another family name in column A row 2 have all of those unique codes that match to the family return under the last column B returned value.

IE:
Houses |5656
Trucks | 6581
..........| 6568
..........| 7878
..........| 6655
..........| 5656
..........| 6363
..........| 2236

I would need to enter up to about 30 max family names in column A to return up to 1500 values. The intention is that I would have 30 drop down boxes in column A and that would build my list of codes which would then lookup values for them out of a data pool.

Is this even possible without advance VBA?

Thank-you a ton for any advice!!

-Bkrup

 

[DanteAmor]

Don't worry, I'm here to help you.
Try the following:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column > 1 Then Exit Sub
  If Target.Count > 100 Then Exit Sub
  Dim sh As Worksheet, c As Range, ary As Variant
  Application.ScreenUpdating = False
  Set sh = Sheets("Sheet1")
  Range("B:B").ClearContents
  If WorksheetFunction.CountA(Range("A1", Range("A" & Rows.Count).End(xlUp))) = 0 Then Exit Sub
  ary = Application.Transpose(Range("A1", Range("A" & Rows.Count).End(xlUp)).Value2)
  [COLOR=#0000ff]sh.Range("A:A")[/COLOR].AutoFilter 1, ary, xlFilterValues
  sh.Range("B:B").Copy Range("B1")
  On Error Resume Next
  sh.ShowAllData
End Sub

 

[bkrupa]

That worked!!

If my "entry column" starts at N8 and my desired output column starts at O8 would I make the changes in red below?

Thanks again so much!!

Don't worry, I'm here to help you.
Try the following:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column > 1 Then Exit Sub
  If Target.Count > 100 Then Exit Sub
  Dim sh As Worksheet, c As Range, ary As Variant
  Application.ScreenUpdating = False
  Set sh = Sheets("Sheet1")
  Range("B:B").ClearContents
  If WorksheetFunction.CountA(Range("[COLOR=#ff0000]N8[/COLOR]", Range("[COLOR=#ff0000]N[/COLOR]" & Rows.Count).End(xlUp))) = 0 Then Exit Sub
  ary = Application.Transpose(Range("[COLOR=#FF0000]N8[/COLOR]", Range("[COLOR=#FF0000]N[/COLOR]" & Rows.Count).End(xlUp)).Value2)
  [COLOR=#0000ff]sh.Range("A:A")[/COLOR].AutoFilter 1, ary, xlFilterValues
  sh.Range("B:B").Copy Range("[COLOR=#ff0000]O8[/COLOR]")
  On Error Resume Next
  sh.ShowAllData
End Sub

 

[DanteAmor]

It is not enough, this is designed for A and B.
Better explain to me where exactly your data is and where exactly you want to put the result.

 

[DanteAmor]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column > Columns("N").Column Then Exit Sub
  If Target.Row < 8 Then Exit Sub
  If Target.Count > 100 Then Exit Sub
  Dim sh As Worksheet, c As Range, ary As Variant
  Application.ScreenUpdating = False
  Set sh = Sheets("Sheet1")
  Range("O8:O" & Rows.Count).ClearContents
  If WorksheetFunction.CountA(Range("N8:N" & Rows.Count)) = 0 Then Exit Sub
  ary = Application.Transpose(Range("N8", Range("N" & Rows.Count).End(xlUp)).Value2)
  sh.Range("A:A").AutoFilter 1, ary, xlFilterValues
  sh.Range("B1:B" & sh.Range("B" & Rows.Count).End(xlUp).Row).Copy Range("O8")
  On Error Resume Next
  sh.ShowAllData
End Sub

 

[bkrupa]

My apologies. If the results need to be in A and B for the code to be reliable I can try to build the sheet that way. The way it is currently built the input is in column N starting in row 8 and the output is in column AY starting in row 8. I could move the input to A2 (room for header) if needed but I will need room between the input and output columns. I could have the output in column B if I hide it but that may effect the VBA?

Thank-you again for all the help.

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column > Columns("N").Column Then Exit Sub
  If Target.Row < 8 Then Exit Sub
  If Target.Count > 100 Then Exit Sub
  Dim sh As Worksheet, c As Range, ary As Variant
  Application.ScreenUpdating = False
  Set sh = Sheets("Sheet1")
  Range("O8:O" & Rows.Count).ClearContents
  If WorksheetFunction.CountA(Range("N8:N" & Rows.Count)) = 0 Then Exit Sub
  ary = Application.Transpose(Range("N8", Range("N" & Rows.Count).End(xlUp)).Value2)
  sh.Range("A:A").AutoFilter 1, ary, xlFilterValues
  sh.Range("B1:B" & sh.Range("B" & Rows.Count).End(xlUp).Row).Copy Range("O8")
  On Error Resume Next
  sh.ShowAllData
End Sub

 

[DanteAmor]

I sent you an update in post #13 .


I don't understand where you're going to capture or where you want the output. N8 or AY?

I am happy to help you, but you should be clear about the following:
1. Sheet1 origin, initial family cell, initial cell code.
2. Sheet2 destination, initial cell input, initial cell output.


With those, from the beginning, the macro would be working.

 

[bkrupa]

Sorry clarified below

Thank-you again so much for all of the help!!!

I sent you an update in post #13 .


I don't understand where you're going to capture or where you want the output. N8 or AY?

I am happy to help you, but you should be clear about the following:
1. Sheet1 origin, initial family cell, initial cell code.This can be A1 (family cell), B1 (cell code) as you originally did it as it is a data tab that will be hidden so I can build however it needs to be
2. Sheet2 destination, initial cell input, initial cell output. Initial input cell is N8, Initial output cell is AY8.




With those, from the beginning, the macro would be working.

 

[DanteAmor]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column > Columns("N").Column Then Exit Sub
  If Target.Row < 8 Then Exit Sub
  If Target.Count > 100 Then Exit Sub
  Dim sh As Worksheet, c As Range, ary As Variant
  Application.ScreenUpdating = False
  Set sh = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
  Range("[COLOR=#0000ff]AY8:AY[/COLOR]" & Rows.Count).ClearContents
  If WorksheetFunction.CountA(Range("N8:N" & Rows.Count)) = 0 Then Exit Sub
  ary = Application.Transpose(Range("N8", Range("N" & Rows.Count).End(xlUp)).Value2)
  sh.Range("A:A").AutoFilter 1, ary, xlFilterValues
  sh.Range("B1:B" & sh.Range("B" & Rows.Count).End(xlUp).Row).Copy Range("[COLOR=#0000ff]AY8[/COLOR]")
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
End Sub

 

[bkrupa]

It worked perfectly!

You literally made my month!

Thank-you again so much!!

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column > Columns("N").Column Then Exit Sub
  If Target.Row < 8 Then Exit Sub
  If Target.Count > 100 Then Exit Sub
  Dim sh As Worksheet, c As Range, ary As Variant
  Application.ScreenUpdating = False
  Set sh = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
  Range("[COLOR=#0000ff]AY8:AY[/COLOR]" & Rows.Count).ClearContents
  If WorksheetFunction.CountA(Range("N8:N" & Rows.Count)) = 0 Then Exit Sub
  ary = Application.Transpose(Range("N8", Range("N" & Rows.Count).End(xlUp)).Value2)
  sh.Range("A:A").AutoFilter 1, ary, xlFilterValues
  sh.Range("B1:B" & sh.Range("B" & Rows.Count).End(xlUp).Row).Copy Range("[COLOR=#0000ff]AY8[/COLOR]")
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
End Sub

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.