CHM0123456  SRM0123:01
CHM0123456  SRM0123:02
CHM0123456  SRM0256:12
CHM0123456  SRM0123:03
CHM0123457  SRM0789:01
CHM0123457  SRM0789:02
CHM0123457  SRM0789:03
CHM0123457  SRM0789:04

=INDEX($C$2:$C$6, SMALL(IF($B$8=$B$2:$B$6, ROW($B$2:$B$6)-MIN(ROW($B$2:$B$6))+1, ""), ROW(A1)))

For x = 1 to 6555
if Ax = Chm123456
string = string + Bx
else
next

For x = 2 To 6555
If Cells(x, 1).Value = "CHM0123456" Then
outstring = outstring + vbCr + Cells(x, 2).Value


End If


Next
MsgBox (outstring)

End Function

Function ListUnique(ByVal search_text As String, _
                    ByVal cell_range As range, _
                    Optional seperator As String = ", ") As String

Application.ScreenUpdating = False
Dim result As String
Dim i as Long
Dim cell As range
Dim keys As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")

On Error Resume Next
For Each cell In cell_range
    If cell.Value = search_text Then
        dict.Add cell.Offset(, 1).Value, 1
    End If
Next

keys = dict.keys
For i = 0 To UBound(keys)
    result = result & (seperator & keys(i))
Next

If Len(result) <> 0 Then
    result = Right$(result, (Len(result) - Len(seperator)))
End If

ListUnique = result
Application.ScreenUpdating = True

End Function

vData=rUnique

dim i as long
dim runique as range, reach as range
dim sData as string
dim vdata as variant

set runique=advancedfilter(...) 'Filter in place
set runique=runique.specialcells(xlCellTypeVisible)
for each reach in runique.areas
 vdata=reach
 for i=lbound(vdata) to ubound(vdata)
  sdata=sdata & vdata(i,1)
 next l
next reach

dim wks as worksheet

for each wks in Activeworkbook.Worksheets
 if wks.name <> "CopiedToWorksheet" then
  advancedfilter(...) 'Copy to bottom of list, so you'll need code for that
 end if
next wks
vdata=activeworkbook.sheets("CopiedToWorksheet").usedrange
sData=vdata(1,1)
for i=lbound(vdata) + 1 to ubound(vdata)
 sData=sData & ","
next i

On Error Resume Next
 wks.ShowAllData
On Error GoTo 0
wks.UsedRange.Rows.Hidden = False
wks.UsedRange.Columns.Hidden = False
rFilterLocation.ClearContents