Macro help needed. Need it not to copy filtered cells

[reyramirez27]

This is a copy macro that copies down based on user input from a pop up box. The issue is that when the excel sheet is filtered it will copy the filtered out data. How can this be modified to only count visible cells? Appreciate the assistance.

Public Function CSOfSelection() As String
Dim sOut As String
Dim i As Integer
Dim area
Dim cell
Dim iRows As Variant

iRows = InputBox("Enter number of rows:")
If IsNumeric(CInt(iRows)) = False Then
Exit Function
Else
iRows = CInt(iRows)
End If

Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row + iRows - 1, ActiveCell.Column)).Copy
ActiveWindow.SmallScroll down:=iRows - 3

'First check to see if there is a valid FN in the active Workbook selected
If Not ActiveWorkbook Is Nothing Then
If TypeOf Selection Is Excel.Range Then
For Each area In Selection.Areas
For Each cell In area
sOut = sOut & cell.Value & "," ''This can be changed to fit whatever functions you need for the data in the selection
Next cell
Next area
End If
End If

sOut = Left(sOut, Len(sOut) - 1) ''This chops off the trailing comma

CSOfSelection = sOut
End Function

 

[Anthony47]

Try adding an If /Endif as follows:

For Each Cell In area                           'Your For Each /Next loop
    If Cell.EntireRow.Hidden = False Then       'Added If /Endif
        sOut = sOut & Cell.Value & "," ''This can be changed to fit whatever functions you need for the data in the selection
    End If
Next Cell

 

[reyramirez27]

Thanks for the response. This didn't copy the hidden cells but it didn't count down as far as I needed it to. For example, when I had the cells hidden it did highlight them but only copied visible cells. This however limited the number of visible cells to copy.

Try adding an If /Endif as follows:

For Each Cell In area                           'Your For Each /Next loop
    If Cell.EntireRow.Hidden = False Then       'Added If /Endif
        sOut = sOut & Cell.Value & "," ''This can be changed to fit whatever functions you need for the data in the selection
    End If
Next Cell

 

[Anthony47]

So your request was "I don't what that hidden cells be copied and counted"

I reviewed your function and coded it the following way:

Public Function CSOfSelection() As String
Dim sOut As String
Dim i As Integer
Dim area
Dim cell
Dim iRows As Variant
'
Dim fIrows As Integer, tArea As Range
'
iRows = InputBox("Enter number of rows:")
If IsNumeric(CInt(iRows)) = False Then
    Exit Function
Else
    iRows = CInt(iRows)
    fIrows = iRows
End If
'
Do
'make sure the area includes the requested number of Rows:
    Set tArea = ActiveCell.Resize(iRows, 1)
    If Application.WorksheetFunction.Subtotal(103, tArea) >= fIrows Then Exit Do
    iRows = iRows + 1
    DoEvents
Loop
''Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row + iRows - 1, ActiveCell.Column)).Copy
'
'First check to see if there is a valid FN in the active Workbook selected
If Not ActiveWorkbook Is Nothing Then               'probably useless here
'    If TypeOf Selection Is Excel.Range Then         'probably useless here
        For Each area In tArea            'probably useless here
            For Each cell In area
                If cell.EntireRow.Hidden = False Then       'Added If /Endif
'                    Debug.Print cell.Address(0, 0)
                    sOut = sOut & cell.Value & "," ''This can be changed to fit whatever functions you need for the data in the selection
                End If
            Next cell
        Next area
'    End If
End If
'
sOut = Left(sOut, Len(sOut) - 1) ''This chops off the trailing comma
'
CSOfSelection = sOut
End Function

Test that it behave as expected; if "Not" you shoud better describe what you wish to achieve

 

[reyramirez27]

Thank y

So your request was "I don't what that hidden cells be copied and counted"

I reviewed your function and coded it the following way:

Public Function CSOfSelection() As String
Dim sOut As String
Dim i As Integer
Dim area
Dim cell
Dim iRows As Variant
'
Dim fIrows As Integer, tArea As Range
'
iRows = InputBox("Enter number of rows:")
If IsNumeric(CInt(iRows)) = False Then
    Exit Function
Else
    iRows = CInt(iRows)
    fIrows = iRows
End If
'
Do
'make sure the area includes the requested number of Rows:
    Set tArea = ActiveCell.Resize(iRows, 1)
    If Application.WorksheetFunction.Subtotal(103, tArea) >= fIrows Then Exit Do
    iRows = iRows + 1
    DoEvents
Loop
''Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.Row + iRows - 1, ActiveCell.Column)).Copy
'
'First check to see if there is a valid FN in the active Workbook selected
If Not ActiveWorkbook Is Nothing Then               'probably useless here
'    If TypeOf Selection Is Excel.Range Then         'probably useless here
        For Each area In tArea            'probably useless here
            For Each cell In area
                If cell.EntireRow.Hidden = False Then       'Added If /Endif
'                    Debug.Print cell.Address(0, 0)
                    sOut = sOut & cell.Value & "," ''This can be changed to fit whatever functions you need for the data in the selection
                End If
            Next cell
        Next area
'    End If
End If
'
sOut = Left(sOut, Len(sOut) - 1) ''This chops off the trailing comma
'
CSOfSelection = sOut
End Function

Test that it behave as expected; if "Not" you shoud better describe what you wish to achieve

Thank you Anthony. For the quick responses and for solving my issue.

 

[Anthony47]

Thank you for the feedback