• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 71
  • Last Modified:

Select all visible rows after an autofilter is applied.

After an autofilter is applied, I used this to select the visible cells that are the result
How would I chg this to select the rows instead of the cells?


Dim rng As Range
  Set rng = ActiveSheet.AutoFilter.Range.Offset(1, 0)
  Set rng = rng.Resize(rng.Rows.Count - 1)
  Set rng = rng.SpecialCells(xlCellTypeVisible)
  rng.Select

Open in new window

0
RWayneH
Asked:
RWayneH
  • 6
  • 6
1 Solution
 
Martin LissRetired ProgrammerCommented:
Range(rng.Row & ":" & rng.Rows.Count).Select
0
 
RWayneHAuthor Commented:
This failed, the autofilter was on 18 rows, after your line only one was selected, unless it selected 17 of the hidden rows?
Any other idea?
0
 
Martin LissRetired ProgrammerCommented:
Can you supply a workbook that has the data you want to filter, tell me what to filter it on, and what rows (by row numbers) you want to select?
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
RWayneHAuthor Commented:
Any autofilter should due, I am testing with an autofilter preset, the one I plan on using is commented out at the beginning of the code.  Trying to move rows from TimeTracker sheet to the ArchiveLog inserting them without formulas and removing them from TimeTracker after they are copied to the other sheet.

Sub ArchiveSelectedRows()
' testing with a preselected autofilter
' Need to test with all rows =B2<=TODAY()-7  which produces a T/F in and hidden column G
' Selection.AutoFilter Field:=7, Criteria1:="TRUE"
    
 Dim varAnswer As String
 varAnswer = MsgBox("Are you sure you want to archive data?  Click on No button to Exit.    ", vbYesNo, "To continue with archive, Press yes.")  'In case button is clicked by mistake
    If varAnswer = vbNo Then
        Exit Sub
    End If
    
 'Issue, does not select row, selects cells... !!  so insert xlDown  Ln  fails.
 'Need this to select the rows, not the cells.
 
  Dim rng As Range
  Set rng = ActiveSheet.AutoFilter.Range.Offset(1, 0)
  Set rng = rng.Resize(rng.Rows.Count - 1)
  Set rng = rng.SpecialCells(xlCellTypeVisible)
  rng.Select
  
  Range(rng.Row & ":" & rng.Rows.Count).Select
  Selection.Cut
  
  Sheets("LogArchived").Select
  Rows("8:8").Select
    
    'Need to insert paste special values to take formulas out.
    Selection.Insert Shift:=xlDown  'need whole row selected here so it send everything.
    
    'my attempt to get formulas out.
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("TaskTracker").Select
    ActiveSheet.UsedRange.AutoFilter Field:=2
    Range("B7").Select
    
    End Sub

Open in new window

TimeTracker.xls
0
 
Martin LissRetired ProgrammerCommented:
See if this does what you want.

  Range(rng.Row & ":" & rng.Row + rng.Rows.Count - 1).Select
0
 
RWayneHAuthor Commented:
Yup that was it.  I can post final code and workbook tomorrow.  It will not chop out sets of data blocks but there should be no rows left that are more than a week old.  Working great thanks.
0
 
Martin LissRetired ProgrammerCommented:
If you can explain what "It will not chop out sets of data blocks but there should be no rows left that are more than a week old" maybe I can help.
0
 
RWayneHAuthor Commented:
it is in the delete empty rows after they are cut out and inserted in the destination sheet.  When you go back to the target sheet, the blank rows are not shifting up.  In fact they are left as is, blank.  So if you  do not select all rows older than 7 days.  This will not work.  By blocks, what I mean is if you just picked a random day, it leaves a gap in the source sheet.  Perhaps running a process to remove blank rows from the source sheet beginning at row 7?  Doing a xlup from bottom to find the bottom of the dataset, and kill any rows that are above that to row 6.  That would work nice.  I will post what I have so far tomorrow.  Thanks.
0
 
Martin LissRetired ProgrammerCommented:
Add the new line as shown below near the end of the Sub. Is that what you want?

    Application.CutCopyMode = False
    Sheets("TaskTracker").Select
    'new
    Selection.Delete

   
    ActiveSheet.UsedRange.AutoFilter Field:=2
    Range("B7").Select
   
    End Sub
0
 
RWayneHAuthor Commented:
Both suggestions worked.  Posted final code below and attached file.  It is a GREAT tool to track time spent on items throughout a day.  THANKS for the help.

Sub ArchiveSelectedRows()
 Sheets("TaskTracker").Select
 Range("B6").Select
' Selection.AutoFilter Field:=7, Criteria1:="TRUE"  'Adds a filter to keep a weeks worth of data in TimeTracker sheet
    
 Dim varAnswer As String
 varAnswer = MsgBox("Are you sure you want to archive data?  Click on No button to Exit.    ", vbYesNo, "To contine with archive, Press yes.")
    If varAnswer = vbNo Then
        Exit Sub
    End If
  
  If ActiveSheet.AutoFilterMode = False Then
    MsgBox ("Systems has deteched that there is not an autofilter applied.  It is not advised to clear the whole sheet.  This procedure is being termiated, however it is turning on the autofilter.  Please select date/s that you want to archive, and try again.")
    Rows("6:6").Select
    Selection.AutoFilter
    Exit Sub
  End If
  
  Dim rng As Range
  Set rng = ActiveSheet.AutoFilter.Range.Offset(1, 0)
  Set rng = rng.Resize(rng.Rows.Count - 1)
  Set rng = rng.SpecialCells(xlCellTypeVisible)
  rng.Select
  Range(rng.Row & ":" & rng.Row + rng.Rows.Count - 1).Select
  
  Selection.Cut
  Sheets("LogArchived").Select
  Rows("8:8").Select
  'Need to insert paste special values to take formulas out.
  Selection.Insert Shift:=xlDown  'need whole row selected here so it send everything.
  Cells.Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  Range("B8").Select
  
  Sheets("TaskTracker").Select
  Selection.Delete
  Selection.AutoFilter 'turnoff autofilter
  Range("B7").Select
End Sub

Open in new window

TimeTracker.xls
0
 
RWayneHAuthor Commented:
EXCELent!!  Thanks for the help with this.
0
 
Martin LissRetired ProgrammerCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now