Using Vba to acquire lookup results in one cell

[Sazzle14]

Hi I used the formula below in trying to solve a puzzle I have, and it has got really close to what I need. It presented the results in col 1 and 2 below (C and D in your formula). However, What I need is to get the results separately i.e. Results for "7" in one cell in the spreadsheet and Results for "8" in another and the same with 9. So I need the formula to specify what it is looking for in column "BoX" but deliver the results in the same way it did for Column 1 and 2. I.e. it brings back multiple values with either a "," to separate or if possible a soft return {alt & Enter}
I know I am asking a lot but would so appreciate your help, I have tried Index and other VBA solutions and not having much luck.

[TABLE="class: cms_table, width: 432"]
<tbody>[TR]
[TD]Box[/TD]
[TD]Name[/TD]
[TD]Column1[/TD]
[TD]Column2[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD]Corel[/TD]
[TD="align: right"]7[/TD]
[TD]Corel , Steph , Jen , Amanda[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD]Steph[/TD]
[TD="align: right"]8[/TD]
[TD]Carol, Amer, Vicky, Charlotte, David[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD]Jen[/TD]
[TD="align: right"]9[/TD]
[TD]Kam, Gwen , Raj, David, Mark , Emma[/TD]
[/TR]
[TR]
[TD="align: right"]7[/TD]
[TD]Amanda[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD]Carol[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD]Amer[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD]Vicky[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD]Charlotte[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]8[/TD]
[TD]David[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD]Kam[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD]Gwen[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD]Raj[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD]David[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD]Mark[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: right"]9[/TD]
[TD]Emma[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Originally Posted by Tinbendr
Welcome to the board!

Code:

Sub MergeGroups()
 Dim WS As Worksheet
 Dim Rng As Range
 Dim LastRow As Long
 Dim Ctr As Long
 Dim Temp$
     'Result Row
     Ctr = 1

     Set WS = ActiveWorkbook.ActiveSheet
     With WS
         'Last row of column A with data.
         LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

         'Loop through each item in Col A.
         For Each Rng In Range("A2:A" & LastRow)
             'Compare to next item down.  If equal build user string.
             If Rng.Offset(1, 0).Value = Rng.Value Then
                 Temp$ = Temp$ & Rng.Offset(0, 1).Value & ", "
             Else
                 'Servers no longer match.
                 Ctr = Ctr + 1
                 'Add last match
                 Temp$ = Temp$ & Rng.Offset(0, 1).Value
                 'Post to Col C & D.
                 .Range("C" & Ctr).Value = Rng.Value
                 .Range("D" & Ctr).Value = Temp$
                 'Clear Temp$
                 Temp$ = ""
             End If
         Next
     End With
 End Sub

 

[Sazzle14]

Just typed it in - although now I feel you are probably shaking your head in disbelief - eek!

With CreateObject("scripting.dictionary")
      For Each Cl In Range("F2", Range("F" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, 1).Value
         Else
            .Item(Cl.Value) = .Item(Cl.Value) & Chr(10) & Cl.Offset(, 1).Value
         End If
      Next Cl
      Worksheet("Sheet1").Range("j5").Value = .Item(1)
      Worksheet("Sheet1").Range("K5").Value = .Item(2)
      Worksheet("Sheet1").Range("l5").Value = .Item(3)
      Worksheet("Sheet1").Range("j6").Value = .Item(4)
      Worksheet("Sheet1").Range("k6").Value = .Item(5)
      Worksheet("Sheet1").Range("l6").Value = .Item(6)
      Worksheet("Sheet1").Range("j7").Value = .Item(7)
      Worksheet("Sheet1").Range("k7").Value = .Item(8)
      Worksheet("Sheet1").Range("l7").Value = .Item(9)
   End With
End Sub

 

[Fluff]

You've missed the s from the end of worksheets

 

[Sazzle14]

Oh my goodness yes I have!!! Yes it is perfect!! thank you so so so much and thank you for being so patient!!

 

[Fluff]

You're welcome