Search code examples
excelvbaloopscellvisible

Copy only visible cells from a Table column to one column separated by a comma in Excel VBA, Loop


Hello all smart people out there,

I am working on a macro which allows me to copy values of a filtered column table to a single cell separated by a comma. I get my code to work for an unfiltered table but I can't figure out how to make it work for a filtered column.

I want to copy the values of the cell after that.

I know that I should probably use SpecialCells(xlCellTypeVisible) but I can't figure out where in my code.

This code starts at row number 11

Sub Onecell()
Dim i As Integer
Dim count As Integer
Dim s As String
count = Cells(Rows.count, "A").End(xlUp).Row
For i = 11 To count
s = s & Cells(i, 1) & ","
Next
Range("D11") = s

Range("D11").Select
Selection.Copy

End Sub

The expected results is the following:

Let's say that I have a table like this.

USA     2019
SWEDEN      2019
NORWAY      2019
INDIA       2020
GERMANY     2020
SPAIN       2020

If I filter the table for 2019 for example,

then I only want in cell D11 USA, SWEDEN, NORWAY

If I filter for 2020 then I want in cell D11 INDIA, GERMANY, SPAIN

I'm quite sure that the problem is that I have to put

SpecialCells(xlCellTypeVisible) somewhere

Any help is highly appriciated


Solution

  • This should work for you:

    Option Explicit
    Sub Onecell()
    
        Dim count As Integer
        Dim JoinCells As New Scripting.Dictionary 'You need to go to tools-->references--> Check: Microsoft Scripting Runtime
        Dim C As Range
    
        With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your sheet name
            count = .Cells(.Rows.count, "A").End(xlUp).Row
            For Each C In .Range("A11", .Cells(count, 1)).SpecialCells(xlCellTypeVisible) 'like this you will only loop through visible ones
                If Not JoinCells.Exists(C.Value) Then JoinCells.Add C.Value, 1 'store all the visible items
            Next C
            .Range("D11") = Join(JoinCells.Keys, ", ")
        End With
    
    End Sub