VBA - How to Select/Copy first 12 Visible cells on filtered data (minus header A1)

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
871
Office Version
  1. 365
Platform
  1. Windows
Hello

I have googled this question but have yet to find something that works and seem to be having an off day...

I have a table called "DATA" and what I am looking for is a VBA code that will select the first 12 cells in column A (minus the header in A1), copy those visible cells and paste them into 2 separate spreadsheets.

How would I go about selecting the first 12 visible cells in column A on a filtered table?

Thank you to anyone who can help :)

Carla
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Carla

Do you only want the values from the first 12 cells?
 
Upvote 0
Carla

Do you only want the values from the first 12 cells?

I want to copy and paste the values, see below code:

VBA Code:
Sub RS()
'
' RS Macro
'

'
    Sheets("DATA").Select
    ActiveSheet.ListObjects("DATA").Range.AutoFilter Field:=5, Criteria1:="N"
    
'Select first 12 visible cells after header in column A

    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Previously Audited").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Random Sample").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
End Sub
 
Upvote 0
The problem with filtered data is that you can end up with non-contiguous rows so you can't simple use Resize to extract the no of values you want.

Something like this might work, the function GetNValues should return the first n values from the range passed to it.
VBA Code:
Sub RS()
Dim rngFiltered As Range
Dim arrValues As Variant

    Sheets("DATA").ListObjects("DATA").Range.AutoFilter Field:=5, Criteria1:="N"

    Set rngFiltered = Sheets("DATA").Columns(1).SpecialCells(xlCellTypeVisible)

    arrValues = GetNValues(rngFiltered, 12)
    
    Sheets("Previously Audited").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(12).Value = arrValues
    Sheets("Random Sample").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(12).Value = arrValues
    
End Sub

Function GetNValues(rng As Range, lngNum As Long) As Variant
Dim rngArea As Range
Dim cl As Range
Dim cnt As Long
Dim arrValues As Variant

    ReDim arrValues(1 To lngNum)
    
    cnt = 1
    
    For Each rngArea In rng.Areas
        For Each cl In rngArea.Cells
            arrValues(cnt) = cl.Value
            cnt = cnt + 1
            
            If cnt = lngNum Then Exit For
        Next cl
        If cnt = lngNum Then Exit For
    Next rngArea
    
    GetNValues = arrValues
    
End Function
 
Upvote 0
I had to adjust my code slightly after posting as I forgot something. Since your code is very different from what I had, how would you adjust the below with the change?
I didn't think it would be this complicated....

VBA Code:
    Sheets("DATA").Select
    ActiveSheet.ListObjects("DATA").Range.AutoFilter Field:=5, Criteria1:="N"
    
'Select first 12 visible cells after header in column A

    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    
    Sheets("Random Sample").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    
    Sheets("Previously Audited").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("B2").Select
     LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2:B" & LastRowColumnA).Formula = "Y"
     Range("A1").Select
     Sheets("Random Sample").Select
 
Upvote 0
The problem with filtered data is that you can end up with non-contiguous rows so you can't simple use Resize to extract the no of values you want.

Something like this might work, the function GetNValues should return the first n values from the range passed to it.
VBA Code:
Sub RS()
Dim rngFiltered As Range
Dim arrValues As Variant

    Sheets("DATA").ListObjects("DATA").Range.AutoFilter Field:=5, Criteria1:="N"

    Set rngFiltered = Sheets("DATA").Columns(1).SpecialCells(xlCellTypeVisible)

    arrValues = GetNValues(rngFiltered, 12)
   
    Sheets("Previously Audited").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(12).Value = arrValues
    Sheets("Random Sample").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(12).Value = arrValues
   
End Sub

Function GetNValues(rng As Range, lngNum As Long) As Variant
Dim rngArea As Range
Dim cl As Range
Dim cnt As Long
Dim arrValues As Variant

    ReDim arrValues(1 To lngNum)
   
    cnt = 1
   
    For Each rngArea In rng.Areas
        For Each cl In rngArea.Cells
            arrValues(cnt) = cl.Value
            cnt = cnt + 1
           
            If cnt = lngNum Then Exit For
        Next cl
        If cnt = lngNum Then Exit For
    Next rngArea
   
    GetNValues = arrValues
   
End Function
Actually your code doesnt work. It only returns the header 12 times
 
Upvote 0
What's different between the two sets of code?

Is it only this part?
VBA Code:
  LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2:B" & LastRowColumnA).Formula = "Y"
     Range("A1").Select
 
Upvote 0
Does it work any better if the function is changed to this?
VBA Code:
Function GetNValues(rng As Range, lngNum As Long) As Variant
Dim rngArea As Range
Dim cl As Range
Dim cnt As Long
Dim arrValues As Variant

    ReDim arrValues(1 To lngNum, 1 To 1)
    
    cnt = 1
    
    For Each rngArea In rng.Areas
        For Each cl In rngArea.Cells
            arrValues(cnt, 1) = cl.Value
            cnt = cnt + 1
            
            If cnt = lngNum Then Exit For
        Next cl
        If cnt = lngNum Then Exit For
    Next rngArea
    
    GetNValues = arrValues
    
End Function
 
Upvote 0
This new code below seems to work however it still selects the Header in A1.

Any idea how to modify this so it does not select the header in A1?

VBA Code:
Sub RS()
'
' RS Macro
'

'
    Sheets("DATA").Select
    ActiveSheet.ListObjects("DATA").Range.AutoFilter Field:=5, Criteria1:="N"
  
   Dim looper As Integer
   looper = 1
 
   Range("A1").Activate
   Do While looper < 12
   Selection.Offset(1, 0).Activate
      Do While ActiveCell.RowHeight = 0
      Selection.Offset(1, 0).Activate
      Loop
   looper = looper + 1
   Loop

   Range("A1:A" & ActiveCell.Row).Select

    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
  
    Sheets("Random Sample").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
  
    Sheets("Previously Audited").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Range("B2").Select
     LastRowColumnA = Cells(Rows.Count, 1).End(xlUp).Row
    Range("B2:B" & LastRowColumnA).Formula = "Y"
     Range("A1").Select
     Sheets("Random Sample").Select

End Sub
 
Upvote 0
Assuming the row 1 is the header row start at A2 instead of A1.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top