Solved

Select all visible rows after an autofilter is applied.

Posted on 2015-02-11
12
65 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 6
12 Comments
 
LVL 48

Expert Comment

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

Author Comment

by:RWayneH
ID: 40604680
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 48

Expert Comment

by:Martin Liss
ID: 40604699
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
Instantly Create Instructional Tutorials

Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.

 

Author Comment

by:RWayneH
ID: 40604724
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 48

Accepted Solution

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

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

Author Comment

by:RWayneH
ID: 40604867
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
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40604915
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
ID: 40604933
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 48

Expert Comment

by:Martin Liss
ID: 40604953
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
ID: 40605690
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
ID: 40605693
EXCELent!!  Thanks for the help with this.
0
 
LVL 48

Expert Comment

by:Martin Liss
ID: 40605708
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!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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 …
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

718 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