Excel VBA - How to Get Only Visible Rows (containing values) After Applying Filter

blueeye

New Member
Joined
Aug 20, 2014
Messages
25
Hi gals and guys,

here is my problem:

2d6uyaq.jpg


ConcatenateRange Function:
Code:
Function ConcatenateRange(ByVal cell_range As Range, _                    Optional ByVal seperator As String) As String


Dim cell As Range
Dim newString As String
Dim cellArray As Variant


Dim i As Long, j As Long
cellArray = cell_range.Value


For i = 1 To UBound(cellArray, 1)
    For j = 1 To UBound(cellArray, 2)
        If Len(cellArray(i, j)) <> 0 Then
            newString = newString & (seperator & cellArray(i, j))
        End If
    Next
Next


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


ConcatenateRange = newString


End Function

I would like to get ALL visible rows (containing values) after applying a filter, not only the row A4.

I have tried the following code, but this only output the A4 or more exactly, the rows until the hidden ones.
Code:
AllVisibleRows = ConcatenateRange(Range("A4:A65536").SpecialCells(xlCellTypeVisible))

How could I get all those filtered rows (A4,A6,etc.)?

Thank you in advance.

Regards,
blueeye
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
You show multiple rows where each row contains multiple columns of data... what exactly are you trying to concatenate, Column A only?
 
Upvote 0
One way:

Code:
Sub demo()
    Dim wks         As Worksheet
    Dim r           As Range

    Set wks = ActiveSheet
    Set r = wks.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
    Set r = Intersect(Columns("A"), r)
    MsgBox ConcatenateRange(r, ",")
End Sub

Function ConcatenateRange(r As Range, _
                          Optional sSep As String) As String
    Dim cell        As Range

    For Each cell In r.Cells
        If Len(cell.Text) Then ConcatenateRange = sSep & cell.Value2 & ConcatenateRange
    Next cell

    If Len(ConcatenateRange) Then ConcatenateRange = Mid(ConcatenateRange, 2)
End Function
 
Upvote 0
Hi,

first, thanks for your replies.

What I would like to achieve is to merge all values from column M and send them via e-mail using mailto url.
Code:
appointments = ConcatenateRange(Range("O4:O65536").SpecialCells(xlCellTypeVisible), "%0A")

Code:
Dim url As String
Shell "rundll32.exe url.dll,FileProtocolHandler " & url, vbHide

Code:
Dim tomorrow As String
tomorrow = Format(Date + 1, "d.m.yyyy")

Code:
mailto:""AAA"" <aaa.bbb@ccc-dd.ee>?subject=aaa " & tomorrow & "&body=appointments at: (" & tomorrow & ").%0A%0A" & tomorrow & "%0A" & appointments & "%0A%0A%0Abbb

Once again,
thank you</aaa.bbb@ccc-dd.ee>
 
Upvote 0
In that case, it would be easier to to the visibility check in the catenation function:

Code:
Sub demo()
    MsgBox CatVisible(Range("A2:A65536"))
End Sub

Function CatVisible(ByVal r As Range, _
                    Optional sSep As String) As String
    Dim cell        As Range

    For Each cell In Intersect(r, r.Worksheet.UsedRange).SpecialCells(xlCellTypeVisible).Cells
        If Len(cell.Text) Then CatVisible = sSep & cell.Value2 & CatVisible
    Next cell

    If Len(CatVisible) Then CatVisible = Mid(CatVisible, 2)
End Function
 
Upvote 0
@sgh - Thanks for your exhausting help.

You CatVisible function is quite faster than your ConcatenateRange one.

As you might notice, I am using the special character: "%0A" in my ConcatenateRange function as a separate character.
It works, but I get the "
0A" in the result - of the first cell. Furthermore, the resurt is outputted upside down - how could I fix this?

Thank you.
 
Upvote 0
@sgh - Well, I am sorry. I have just meant that the last cell is outputted as a first. LIFO

123,456,789
it's: 789,456,123

Thank you.
 
Upvote 0
Ah:

Code:
Function CatVisible(r As Range, _
                    Optional sSep As String) As String
    Dim cell        As Range

    For Each cell In Intersect(r, r.Worksheet.UsedRange).SpecialCells(xlCellTypeVisible).Cells
        If Len(cell.Text) Then CatVisible = sSep & CatVisible & cell.Value2
    Next cell

    If Len(CatVisible) Then CatVisible = Mid(CatVisible, Len(sSep) + 1)
End Function
 
Upvote 0
@shg - I have already tried that. But now I get some spaces and bad formatting at all (no lf,cr) when filtering more than one cell.

Again, Thanks.
 
Upvote 0

Forum statistics

Threads
1,214,661
Messages
6,120,792
Members
448,994
Latest member
rohitsomani

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top