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

[blueeye]

Hi gals and guys,

here is my problem:

ConcatenateRange Function:

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.

AllVisibleRows = ConcatenateRange(Range("A4:A65536").SpecialCells(xlCellTypeVisible))

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

Thank you in advance.

Regards,
blueeye

 

[shg]

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

    For Each rRow In Intersect(r, r.Worksheet.UsedRange).Rows
        If Not rRow.EntireRow.Hidden Then
            For Each cell In rRow.Cells
                If Not cell.EntireColumn.Hidden Then
                    If Len(cell.Text) > 0 Then
                        CatVisible = CatVisible & sSep & cell.Value2
                    End If
                End If
            Next cell
        End If
    Next rRow

    If Len(CatVisible) Then CatVisible = Mid(CatVisible, Len(sSep) + 1)
End Function

 

[blueeye]

@shg - Thank you for the code.

I decided to let the VBA do the work.

I have changed the function a bit to take a format function, so that I do no longer need the column "C".

Function CatVisible(r As Range, Optional sSep As String, Optional formatting 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 = CatVisible & sSep & format(cell.Value2, formatting)
    Next cell


    If Len(CatVisible) Then CatVisible = Mid(CatVisible, Len(sSep) + 1)
End Function

For the start, could you please rewrite the CatVisible function so that it outputs an Array?

I would like to access it then by:

outputFromCatVisibleFunction(i)

Also, how can I get the array lenght?
I have read somewhere that this code should do it:

Application.CountA(outputFromCatVisibleFunction)

Thank you again and have a nice rest of the day.

 

[Rick Rothstein]

Function CatVisible([COLOR=#ff0000][B]r As Range[/B][/COLOR], Optional sSep As String, Optional formatting As String) As String

What kind of range are you passing into your function... a column of cells, a row of cells or a multi-row, multi-column rectangular group of cells?

 

[blueeye]

@Rick Rothstein - Thanks for reply.

This is the way I did it:

times = CatVisible(Range("C4:C65536"), ",", "h:mm")
surnames = CatVisible(Range("E4:E65536"), ",")
forenames = CatVisible(Range("F4:F65536"), ",")
addresses = CatVisible(Range("G4:G65536"), ",")
cities = CatVisible(Range("H4:H65536"), ",")
cellnos = CatVisible(Range("I4:I65536"), ",", "# ### ###")
Comments = CatVisible(Range("J4:J65536"), ",")

Is there also any way to simplify this code into a for cycle? Maybe I wouldn't even have to use all those variables.
The best approach would probably be to get all those ranges into one big Array and then access it like:

oneBigArray(4,1) to get Prague, e.g.

And.. What about declaring a variables?
Do I have to declare variables like Dim myString As String in order to be able to work with this variable?

1.

Dim myString As String
myString = "test"
MsgBox(myString)

2.

myString = "test"
MsgBox(myString)

Both methods work, so there is no need to declare basic variables if I ain't gonna to write some complex application, right?
I will try to add many features in the future, but for now I have to ask for help here, since I prefer Python over VBA
(and there is no other alternative when coding in the Excel).

Thank you.

 

[blueeye]

This is the way I have done it:

Function CatVisible(r As Range, Optional formatting As String) As Variant
    Dim arr() As String

    For Each cell In Intersect(r, r.Worksheet.UsedRange).SpecialCells(xlCellTypeVisible).Cells
        ReDim Preserve arr(i)
        arr(i) = Format(cell.Value2, formatting)
        i = i + 1
    Next cell

CatVisible = arr()

Sub button1()

If ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Then
   avs = Range("D4", Cells(Rows.Count, "D")).SpecialCells(xlCellTypeVisible).Cells(1, 1)
ElseIf Not IsEmpty(Range("D4")) And Range("D3:D5").Rows.SpecialCells(xlCellTypeConstants).Count = 2 Then
   avs = Range("D4")
Else
   Call avserr
End If

If avs = "" Then Call avserr

tomorrow = Format(Date + 1, "d.m.yyyy")
times = CatVisible(Range("C4:C65536"), "h:mm")
surnames = CatVisible(Range("E4:E65536"))
forenames = CatVisible(Range("F4:F65536"))
addresses = CatVisible(Range("G4:G65536"))
cities = CatVisible(Range("H4:H65536"))
cellnos = CatVisible(Range("I4:I65536"), "# ### ###")
Comments = CatVisible(Range("J4:J65536"))

For i = 0 To Application.CountA(times) - 1
    If times(i) <> "" Then
        If Comments(i) = "" Then
            dates = dates & times(i) & " - " & surnames(i) & " " & forenames(i) & ", " & addresses(i) & ", " & cities(i) & ", " & cellnos(i) & "%0A"
        Else
            dates = dates & times(i) & " - " & surnames(i) & " " & forenames(i) & ", " & addresses(i) & ", " & cities(i) & ", " & cellnos(i) & " /" & Comments(i) & "/" & "%0A"
        End If
    End If
Next i

Select Case avs
XXX
End Select

Shell "rundll32.exe url.dll,FileProtocolHandler " & url, vbHide

End Sub

Sub avserr()
   MsgBox ("XXX")
   End
End Sub

But maybe there is a better approach - what do you think?

Thank you in advance for any replies.

Kind Regards,
Martin

 

[blueeye]

bump?

 

[blueeye]

bump.. Do you have any ideas how to improve the code?

Thanks

 

[blueeye]

Any ideas for the code optimalization?

Thanks...

 

[blueeye]

bump.. any idea?