Need to pull all values for a lookup, not just the first one.

[lynnrudolph]

Colors	Blue	Colors	Blue
Colors	Green		Green
Clothes	Hats		Red
Clothes	Pants		White
Colors	Red		Yellow
Clothes	Shoes	Clothes	Hats
Clothes	Skirts		Pants
Colors	White		Shoes
Colors	Yellow		Skirts

<tbody>
</tbody>

Hello everyone, thanks in advance for your help. I imagine this is easy, but I'm a bit stumped. I have 2 columns of data like the 2 on the left. I cannot re-sort these and there are many more categories and items. I need to produce something like Columns 3 and 4 on the right. So I need to pull the first value in Column 1 into Column 3 and then look for all the matches in Column 2 and put them in Column 4 in order. Then get the next unique item in Column 1 and do the same thing. Anything you can provide will be appreciated!!

 

[Osvaldo Palmeiro]

Hi, Try:

Sub GetAllValues()
  Dim LR As Long, k As Long, C As Range
  Dim firstAddress As String, x As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  k = 1: Range("C:D").ClearContents
      For x = 1 To LR
        If Application.CountIf(Range("C:C"), Cells(x, "A").Value) = 0 Then
        Cells(k, "C") = Cells(k, "A")
          With Range("A1:A" & LR)
            Set C = .Find(Cells(k, "C").Value, after:=.Cells(LR, "A"))
              If Not C Is Nothing Then
                firstAddress = C.Address
                  Do
                    Cells(k, "D") = C.Offset(, 1).Value
                    Set C = .FindNext(C)
                    k = k + 1
                    If C.Address = firstAddress Then Exit Do
                    Cells(k, "D") = C.Offset(, 1).Value
                  Loop While Not C Is Nothing
              End If
          End With
        End If
      Next x
End Sub

 

[lynnrudolph]

Thank you Osvaldo! I guess it wasn't so easy after all.

Hi, Try:

Sub GetAllValues()
  Dim LR As Long, k As Long, C As Range
  Dim firstAddress As String, x As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  k = 1: Range("C:D").ClearContents
      For x = 1 To LR
        If Application.CountIf(Range("C:C"), Cells(x, "A").Value) = 0 Then
        Cells(k, "C") = Cells(k, "A")
          With Range("A1:A" & LR)
            Set C = .Find(Cells(k, "C").Value, after:=.Cells(LR, "A"))
              If Not C Is Nothing Then
                firstAddress = C.Address
                  Do
                    Cells(k, "D") = C.Offset(, 1).Value
                    Set C = .FindNext(C)
                    k = k + 1
                    If C.Address = firstAddress Then Exit Do
                    Cells(k, "D") = C.Offset(, 1).Value
                  Loop While Not C Is Nothing
              End If
          End With
        End If
      Next x
End Sub

 

[Peter_SSs]

If your question has not already been answered, a couple of points of clraification.

.. look for all the matches in Column 2 and put them in Column 4 in order.

1. What order, alphabetical or original? Your column D values are in alphabetical order in each group, but that happens to be the same order they were in originally in column B.

2. In your original data, the 2nd row is Colors | Green
Is it possible that later in the data another row might also be Colors | Green?
If so, should the second occurrence be ignored or repeated in the results?

 

[lynnrudolph]

Good questions...for #1. The data needs to stay in the same order as the first column (it isn't necessarily alphabetical in the actual data though). For question #2. No, there will be no duplication of values from the combined A/B columns. Maybe there is something less complicated than VBA for me? Thanks for your assistance!!

 

[Peter_SSs]

First, another vba approach that doesn't require looping through each row.
It assumes data is in columns A:B and columns C:D are available for the results.
Test in a copy of your workbook.

Sub BuildTable()
  Application.ScreenUpdating = False
  With Range("C1:D" & Range("A" & Rows.Count).End(xlUp).Row)
    .Columns(1).Formula = "=MATCH(A1,A$1:A1,0)&""#""&A1&IF(COUNTIF(A$1:A1,A1)=1,"""",""#"")"
    .Columns(2).Formula = "=B1"
    .Value = .Value
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    .Replace What:="*#*#", Replacement:="", SearchFormat:=False, ReplaceFormat:=False
    .Replace What:="*#", Replacement:="", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
  End With
  Application.ScreenUpdating = True
End Sub

Maybe there is something less complicated than VBA for me?

I don't see any simple formula approach, but if you want to stay away from vba you could do it manually reasonably easily using the steps my macro does. The steps would be:

1. Put these formulas in C1 and D1 and copy down to the end of the data.

C1: =MATCH(A1,A$1:A1,0)&"#"&A1&IF(COUNTIF(A$1:A1,A1)=1,"","#")
D1: =B1


With the columns C:D formula area ..

2. Copy and Paste Special -> Values

3. Sort ascending, based on column C (no header row)

4. Do a Find/Replace with Find what: *#*# Replace with: ensure field is blank | Replace All

5. Do another Find/Replace with Find what: *# Replace with: ensure field is blank | In Options>> ensure "Match entire cell contents" is NOT checked | Replace All

 

[lynnrudolph]

Thank you Peter. It does work--I'm not sure which I'll use, but thanks for providing BOTH options! It's good to see how it works.