Copying from a filtered range in VBA

[lakshman]

Hi all! I am trying to filter a data file till there is only one row of data (excluding headers) and then I copy the relevant cells in that row. However, there will be some instances where my filter criteria is not enough to filter till one row of data. If that is the case, I want the user to key in their desired data row and the code should copy the relevant parameters from that row. Here is my code.

Sub ELNParametersCopyPaste()
 
Dim csv As Workbook
Dim pdttype As Worksheet
Dim chartbuilder As Workbook
Dim rngDest As Range
Dim copyRange As Range
Dim lastRow As Long
 
Set chartbuilder = Workbooks("Product Write Up Assistant (5 Jan).xlsm")
Set csv = Workbooks("CSV.csv")
Set Research = Workbooks("Investment Rationale & Summary.xlsx")
csv.Activate
 
' Turn off any autofilters that are already set
 
csv.Activate
ActiveSheet.AutoFilterMode = False
 
' Filters for Requesters, Product Type & Ticker 1
 
lastRow = Cells(Rows.Count, "AM").End(xlUp).Row
ActiveSheet.Range("$A$1:$AM" & lastRow).AutoFilter Field:=36, Criteria1:=Array("Hau Tat CHEN", "Rohit JAISINGH", "Wei Lek YEO"), Operator:=xlFilterValues
ActiveSheet.Range("$A$1:$AM" & lastRow).AutoFilter Field:=14, Criteria1:=chartbuilder.Sheets("ELN").Range("C5")
ActiveSheet.Range("$A$1:$AM" & lastRow).AutoFilter Field:=2, Criteria1:=chartbuilder.Sheets("ELN").Range("E1")
 
'After all the filters are in place, this will inform the user that there are multiple rows of data and provide an inputbox for the user to key in which row of data is preferred.
 
Dim RowCount As Integer
Dim Ans As Integer
'counts the number of rows that are visible, -1 to remove the header count
 
csv.Activate
RowCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
 
HANDLE1:
If RowCount > 1 Then
Ans = InputBox("For the Product Type and Ticker(s) that you have given, there are multiple similar products. Which row of data would you like to proceed with?")
 
If Len(Ans) = 0 Then 'Checking if Length of input is 0 characters
MsgBox "Please enter a valid number!", vbCritical
GoTo HANDLE1
 
Else: 'rest of code here
 
' Copy strike
 
Set copyRange = ActiveSheet.Range("R2:R" & Ans +1)
copyRange.SpecialCells(xlCellTypeVisible).Copy
 
chartbuilder.Activate
Set pdttype = Worksheets("ELN")
copyRange.SpecialCells(xlCellTypeVisible).Copy
pdttype.Range("C7").PasteSpecial Paste:=xlPasteValues

    End If
End If

This is my contingency code when an inputbox is used. If the user keys in "2", the code should copy cells from the second row of data. But that is not working. An error pops up saying "no cells found'. How do I edit my code to copy cells from the desired filtered row based on user input?

Thank you!

 

[John_w]

Set copyRange = ActiveSheet.Range("R2:R" & Ans +1)

If the user has to chose only 1 row, that line seems to be referencing at least 2 rows, e.g. cells R2:R3 if the user enters "2". Maybe that is the problem.

To find the visible filtered row corresponding to the chosen data row you have to loop through the Areas collection of the filtered range and the rows in each area, counting the visible rows until it equals the chosen data row number. See if you can incorporate the following into your code:

    Dim filteredRange As Range, row As Long, areaRange As Range
    Dim chosenDataRow As Long, visibleRowCount As Long, foundVisibleRowNumber As Long
    
    Set filteredRange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)

    chosenDataRow = 5    'example - the user wants the 5th visible data row
    visibleRowCount = 0
    foundVisibleRowNumber = 0
    
    For Each areaRange In filteredRange.Areas
        For row = areaRange.row To areaRange.row + areaRange.Rows.Count - 1
            If row > 1 Then visibleRowCount = visibleRowCount + 1  'only count data rows, not headings row
            If visibleRowCount = chosenDataRow Then
                foundVisibleRowNumber = row
                Exit For
            End If
        Next
        If visibleRowCount = chosenDataRow Then Exit For
    Next
    
    If foundVisibleRowNumber > 0 Then
        MsgBox "Chosen data row " & chosenDataRow & " corresponds to row " & foundVisibleRowNumber & " in filtered visible rows"
    Else
        MsgBox "Chosen data row " & chosenDataRow & " doesn't exist in filtered visible rows"
    End If

 

[lakshman]

Hey! Thank you for replying. I actually figured a simple solution to my problem. Instead of keying in the input for the Visible Row number, I can ask the user to key in the actual row number in excel seen on the left. If the two filtered rows are Rows 6 and 14, and he wants the second line of data then he inputs '14" in the input box. I changed my contingency code as below.

[COLOR=#333333]Sub ELNParametersCopyPaste()[/COLOR] 
Dim csv As Workbook
Dim pdttype As Worksheet
Dim chartbuilder As Workbook
Dim rngDest As Range
Dim copyRange As Range
Dim lastRow As Long
 
Set chartbuilder = Workbooks("Product Write Up Assistant (5 Jan).xlsm")
Set csv = Workbooks("CSV.csv")
Set Research = Workbooks("Investment Rationale & Summary.xlsx")
csv.Activate
 
' Turn off any autofilters that are already set
 
csv.Activate
ActiveSheet.AutoFilterMode = False
 
' Filters for Requesters, Product Type & Ticker 1
 
lastRow = Cells(Rows.Count, "AM").End(xlUp).Row
ActiveSheet.Range("$A$1:$AM" & lastRow).AutoFilter Field:=36, Criteria1:=Array("Hau Tat CHEN", "Rohit JAISINGH", "Wei Lek YEO"), Operator:=xlFilterValues
ActiveSheet.Range("$A$1:$AM" & lastRow).AutoFilter Field:=14, Criteria1:=chartbuilder.Sheets("ELN").Range("C5")
ActiveSheet.Range("$A$1:$AM" & lastRow).AutoFilter Field:=2, Criteria1:=chartbuilder.Sheets("ELN").Range("E1")
 
'After all the filters are in place, this will inform the user that there are multiple rows of data and provide an inputbox for the user to key in which row of data is preferred.
 
Dim RowCount As Integer
Dim Ans As Integer
'counts the number of rows that are visible, -1 to remove the header count
 
csv.Activate
RowCount = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
 
HANDLE1:
If RowCount > 1 Then
Ans = InputBox("For the Product Type and Ticker(s) that you have given, there are multiple similar products. Which row of data would you like to proceed with?")
 
If Len(Ans) = 0 Then 'Checking if Length of input is 0 characters
MsgBox "Please enter a valid number!", vbCritical
GoTo HANDLE1
 
Else: 'rest of code here
 
' Copy strike
 
Set copyRange = ActiveSheet.Range("R" & Ans)
copyRange.Copy
 
chartbuilder.Activate
Set pdttype = Worksheets("ELN")
pdttype.Range("C7").PasteSpecial Paste:=xlPasteValues

    End If 
[COLOR=#333333]End If[/COLOR]

But I just want to say thank you so much for putting in effort to explain the looping and providing a possible solution.