combining row values into one cell while filter is active

[bernh.wagner]

Hi all!

I need to combine several row values into one cell. In an older thread I found the macro below:

Sub ReallyBigRow()
''take a column of cells and put all into one big row separated by commas
''originally posted by John Wilson
Dim Lastrow As Long
Dim cell As Range
Dim DataRng As Range
Dim strRow As String
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set DataRng = Range("A1:A" & Lastrow)
For Each cell In DataRng
strRow = strRow & cell.Value & ","
Next cell
Range("B1").Value = strRow
End Sub

This works fine for complete rows (ex. A1:A25). However I would need the same function for a row with active filter (ex. A1,A3,A22,A24 visible).

Any idea someone how I could achieve that?

Thanks

 

[Jim Cone]

Change this part...
'---
For Each cell In DataRng
If Not cell.EntireRow.Hidden Then '<<<
strRow = strRow & cell.Value & ","
End If '<<<
Next cell
'---
Jim Cone
Portland, Oregon USA
http://www.mediafire.com/PrimitiveSoftware
(Extras for Excel add-in)




<[email protected]>
wrote in message
news:370740.8.1322040592042.JavaMail.geo-discussion-forums@vbbdd1...

 

[Don Guillett]

or

Sub OneCell()
Dim c As Range
Dim ms As String
For Each c In Range("a2:a22").SpecialCells(xlCellTypeVisible)
If c <> "" Then Range("f1") = Range("f1") & c & ","
Next c
End Sub

 

[Rick Rothstein]

This macro will automatically determine the range of cells that are filtered
and then create the desired output string. You can set the column to get the
data from via the ColumnNumber constant (the first Const statement) and the
cell address to output the text to via the OutputCellAddress constant (the
second Const statement)...

Sub GetVisibleFilteredColumn()
Dim X As Long, Cell As Range, VisibleRows As String, vArr As Variant,
VisibleFilteredColumn As String
Const ColumnNumber As Long = 1
Const OutputCellAddress As String = "M1"
For Each Cell In
ActiveSheet.AutoFilter.Range.SpecialCells(xlVisible).EntireRow
VisibleRows = VisibleRows & Cell.Row & " "
Next
VisibleRows = Trim(VisibleRows)
vArr = Application.Index(Cells, Application.Transpose(Split(VisibleRows)),
ColumnNumber)
For X = LBound(vArr) + 1 To UBound(vArr)
VisibleFilteredColumn = VisibleFilteredColumn & ", " & vArr(X, 1)
Next
Range(OutputCellAddress).Value = Mid(VisibleFilteredColumn, 3)
End Sub

Rick Rothstein (MVP - Excel)

 

[isabelle]

hi ,

Sub ReallyBigRow()
Dim plg As Range, X As Variant, y As Integer
Set plg = ActiveSheet.Range("_filterdatabase").SpecialCells(xlCellTypeVisible)
X = Split(plg.Address, ",")
For y = 1 To Range(X(1)).Rows.Count
strg = strg & Range(X(1)).Item(y, 1) & ","
Add = Add & Range(X(1)).Item(y, 1).Address & ","
Next
MsgBox strg
MsgBox Add
End Sub

 

[isabelle]

one more overall

this example lists the data and addresses of the second (2) column of the filter

Sub Filtered_Data()
Dim S As Variant
Dim plg As Range, rng As Range, c As Range
Dim i As Integer, dt As String, ad As String
Set plg = ActiveSheet.Range("_filterdatabase").SpecialCells(xlCellTypeVisible)

S = Split(plg.Address, ",")

For i = 0 To UBound(S)
For Each rng In Range(S(i)).Columns(2) 'adapt the "th" column
For Each c In Range(rng.Address)
If c.Address <> ActiveSheet.Range("_filterdatabase")(2).Address Then 'adapt the "th" column
dt = dt & c & ","
ad = ad & c.Address & ","
End If
Next
Next
Next

MsgBox dt
MsgBox ad
End Sub

 

[Bernhard Wagner]

one more overall

this example lists the data and addresses of the second (2) column of thefilter

Sub Filtered_Data()
Dim S As Variant
Dim plg As Range, rng As Range, c As Range
Dim i As Integer, dt As String, ad As String
Set plg = ActiveSheet.Range("_filterdatabase").SpecialCells(xlCellTypeVisible)

S = Split(plg.Address, ",")

For i = 0 To UBound(S)
   For Each rng In Range(S(i)).Columns(2) 'adapt the "th" column
    For Each c In Range(rng.Address)
     If c.Address <> ActiveSheet.Range("_filterdatabase")(2).Address Then 'adapt the "th" column
      dt = dt & c & ","
      ad = ad & c.Address & ","
     End If
    Next
   Next
Next

MsgBox dt
MsgBox ad
End Sub

Wow!

That's a lot of great answers!
Thank you very much for the fast responses!

Bernhard