VBA filter and concatenate

[Dannybert]

I have a workbook where I have 3 tables stacked on Sheet1.

So for example: The first table starts from A2 and ends on A10, the second from A13 to A19 etc.

I want to extract the first column values purely on unique values and without the headers or blank cells. So it should give me a nice column on Sheet2 with only the unique values without any zeros or blanks.

EXAMPLE:
oranges
apples
bananas
pineapples
grapes

Also, I want the filtered values on Sheet2 to be concatenated into another cell with a comma in between the values (except for the last value.

EXAMPLE:
oranges,apples,bananas,pineapples,grapes

I want to use VBA for it so it works in multiple versions of Excel.

 

[Dannybert]

I mean to filter the blanks and headers and be left with unique values, so I don’t want to filter the unique values only! It should display every value but only once like the unique function does in 365.

 

[JEC]

Try running this code

Sub jvr()
  With CreateObject("scripting.dictionary")
     For Each tbl In Sheets(1).ListObjects
        ar = tbl.DataBodyRange
        For i = 1 To UBound(ar)
          If ar(i, 1) <> "" Then c00 = .Item(ar(i, 1))
        Next
     Next
    Sheets(2).Cells(1).Resize(.Count) = Application.Transpose(.keys)
    Sheets(2).Cells(1, 4) = Join(.keys, ", ")
  End With
End Sub

 

[Dannybert]

Try running this code

Sub jvr()
  With CreateObject("scripting.dictionary")
     For Each tbl In Sheets(1).ListObjects
        ar = tbl.DataBodyRange
        For i = 1 To UBound(ar)
          If ar(i, 1) <> "" Then c00 = .Item(ar(i, 1))
        Next
     Next
    Sheets(2).Cells(1).Resize(.Count) = Application.Transpose(.keys)
    Sheets(2).Cells(1, 4) = Join(.keys, ", ")
  End With
End Sub

Hello JEC,

This worked like a charm! Thanks a lot!!!

 

[Peter_SSs]

Here is another possibility with less looping.

Sub MakeList()
  Dim tbl As ListObject
  
  For Each tbl In Sheets(1).ListObjects
    Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(tbl.Range.Rows.Count - 1).Value = tbl.DataBodyRange.Value
  Next tbl
  With Sheets(2).Columns("A")
    .SpecialCells(xlBlanks).Delete Shift:=xlUp
    .RemoveDuplicates Columns:=1, Header:=xlNo
    .Cells(1, 4).Value = Join(Application.Transpose(.SpecialCells(xlConstants).Value), ", ")
  End With
End Sub

 

[Dannybert]

Here is another possibility with less looping.

Sub MakeList()
  Dim tbl As ListObject
 
  For Each tbl In Sheets(1).ListObjects
    Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(tbl.Range.Rows.Count - 1).Value = tbl.DataBodyRange.Value
  Next tbl
  With Sheets(2).Columns("A")
    .SpecialCells(xlBlanks).Delete Shift:=xlUp
    .RemoveDuplicates Columns:=1, Header:=xlNo
    .Cells(1, 4).Value = Join(Application.Transpose(.SpecialCells(xlConstants).Value), ", ")
  End With
End Sub

Thanks for helping, but the other code is working perfectly so I won't need this one now, but I might use it when changing some stuff to improve it

 

[JEC]

it does have less looping, but is has more pasting. On big data sets, the dictionary is probably still faster. In this case you never notice the difference.

 

[Peter_SSs]

In this case you never notice the difference.

Agreed

Thanks for helping, but the other code is working perfectly so I won't need this one now, but I might use it when changing some stuff to improve it

No problem.