Solved

Select all visible rows after an autofilter is applied.

Posted on 2015-02-11
12
58 Views
Last Modified: 2015-02-12
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
Comment
Question by:RWayneH
  • 6
  • 6
12 Comments
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
Range(rng.Row & ":" & rng.Rows.Count).Select
0
 

Author Comment

by:RWayneH
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
 

Author Comment

by:RWayneH
Comment Utility
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
 
LVL 45

Accepted Solution

by:
Martin Liss earned 500 total points
Comment Utility
See if this does what you want.

  Range(rng.Row & ":" & rng.Row + rng.Rows.Count - 1).Select
0
 

Author Comment

by:RWayneH
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
 

Author Comment

by:RWayneH
Comment Utility
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
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
 

Author Comment

by:RWayneH
Comment Utility
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
 

Author Closing Comment

by:RWayneH
Comment Utility
EXCELent!!  Thanks for the help with this.
0
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now