Home > other >  Trying to copy filtered cells and then pasting as value seperating with a comma in a destination cel
Trying to copy filtered cells and then pasting as value seperating with a comma in a destination cel

Time:04-28

My Excel looks like this

Project Type Business Intelligence
1001 Apples
1002 Oranges
1003 Oranges
1004 Bananas
1005 Apples
1006 Apples

So when I filter column "B" to have only Apples I want to be able to paste the "1001, 1005" in the Column C (Business Intelligence Column) of the 6th Row (inline with project 1006) to indicate that we have done Apples twice before. The comma between the values is not important, even a space will do

After reading multiple posts, I came across the closest possible solutions for me.

Option Explicit

Sub CopyToY()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' be more specific
    
    ' First Cell of the Data Range (in the row below headers)
    Dim fCell As Range: Set fCell = ws.Range("A2")
    ' Last Cell of the Filtered Range
    Dim lCell As Range: Set lCell = ws.Range("A" & ws.Rows.Count).End(xlUp)
    ' If no filtered data, the last cell will be the header cell, which
    ' is above the first cell. Check this with:
    If lCell.Row < fCell.Row Then Exit Sub ' no filtered data
    
    ' Range from First Cell to Last Cell
    Dim rg As Range: Set rg = ws.Range(fCell, lCell)
    
    ' Filtered Data Range
    Dim frg As Range: Set frg = rg.SpecialCells(xlCellTypeVisible)
    
    ' Area Range
    Dim arg As Range
    
    For Each arg In frg.Areas



        arg.EntireRow.Columns("Y").Value = arg.Value ' **this is where it all goes wrong for me - I don't want to paste in column Y but in C6 as "1001, 1005"**



    Next arg
    MsgBox "Filtered data copied to column ""Y"".", vbInformation
    
End Sub

Now working towards pasting as value in C6, instead of column Y I found this code.

Sub JoinCells()

Set xJoinRange = Application.InputBox(prompt:="Highlight source cells to merge",    Type:=8)
xSource = 0
xSource = xJoinRange.Rows.Count
xType = "rows"
If xSource = 1 Then
    xSource = xJoinRange.Columns.Count
    xType = "columns"
End If
Set xDestination = Application.InputBox(prompt:="Highlight destination cell", Type:=8)
If xType = "rows" Then
    temp = xJoinRange.Rows(1).Value
    For i = 2 To xSource
        temp = temp & " " & xJoinRange.Rows(i).Value
    Next i
Else
    temp = xJoinRange.Columns(1).Value
    For i = 2 To xSource
        temp = temp & " " & xJoinRange.Columns(i).Value
    Next i
End If

xDestination.Value = temp

End Sub

But unfortunately this code is taking the invisible filtered rows too. Which means my C6 value is showing as 1001 1002 1003 1004 1005 1006

What I want to do is take the first part of the first code and automatically take the contents of the filtered column A (Project) and then use the second part of the second code to be able to paste the answer "1001, 1005" in C6 (Business Intelligence Column, in line with Project 1006) - This can be done either by highlighting the destination cell OR even better automatically choosing the last visible cell in Column C

I am not a programmer have never learnt coding, I just run my own business - tried my best to get this done but unfortunately am unable to be able to successfully merge these two codes.

Any help would be appreciated.

CodePudding user response:

Maybe you want to try something like this ?

Sub test()
Dim rg As Range
Dim i As Integer
Dim cell As Range
Dim x As String

If ActiveSheet.FilterMode Then
Set rg = Range("B2", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
If Application.CountA(rg) < 2 Then Exit Sub
i = 0

    For Each cell In rg
        i = i   1
            If cell.Address = Range("B" & Rows.Count).End(xlUp).Address Then
                cell.Offset(0, 1).Value = x
            Else
                If i = 1 Then x = cell.Offset(0, -1) Else x = x & ", " & cell.Offset(0, -1)
            End If
    Next
    
End If
End Sub

The sub above will not automatically run each time you filter the data, as it need to be run manually after you filter the data. The code also doesn't do error checking (for example if you filter the data with a criteria which doesn't exist in the data).

First the code check if the active sheet is filtered, if yes then it sets the range of the filtered data which visible (the rg variable). If the count of that range is bigger than 1, then the process :

  1. loop to each cell of that range
  2. if it's the first time loop, then it get the value of column A, the looped cell.offset(0,-1) as x variable
  3. if it's not the first time loop, then it will add the value of x with ", " and the value of column A, the looped cell.offset(0,-1).
  4. once the looped cell address is the same with the last row of the visible data of rg, it write the x value to column C in the same row of the last row of the visible data.

Still not sure though if that's what you want. And I wonder if the data will grow or just static. If it will grow, (from your apple example) will there two rows in column C where the last second row contains 1001 and 1005 (the result of the macro before) and the last row contains 1001, 1005 and 1006 ?

  • Related