combining row values into one cell while filter is active

B

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
 
D

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
 
R

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)
 
I

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
 
I

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
 
B

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top