Change Loop to Auto Filter

Question

I want to simplify the following code by changing the loop structure to an auto filter structure.

1
 ActiveCell.Columns("A:A").EntireColumn.Select
 If Selection.Find(What:="~* C", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=True) Is Nothing Then
    GoTo 2
 End If

 Selection.Find(What:="~* C", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=True).Activate
 ActiveCell.Select
 Range(Selection, Selection.Offset(0, 1)).Insert shift:=xlToRight
 GoTo 1
2

score 1 · Answer 1 · edited May 23 '17 at 12:20

Try this one:

Sub test()
    Dim lastrow As Long
    Dim rng As Range
    Dim ar As Range
    'change Sheet1 to suit
    With ThisWorkbook.Worksheets("Sheet1")            
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 'find last row in column A            
        .AutoFilterMode = False 'remove previous filter          
        With .Range("A1:A" & lastrow)                
            .AutoFilter Field:=1, Criteria1:="*~* C*" 'apply filter   

            On Error Resume Next
            Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) 'find visible rows
            On Error GoTo 0
        End With                        
        .AutoFilterMode = False 'remove filter
        'if we found some values - insert
        If Not rng Is Nothing Then 
            rng.Insert Shift:=xlToRight
            rng.Insert Shift:=xlToRight
        End If
    End With
End Sub

If your column A doesn't contain header, use this one for rng:

Set rng = .SpecialCells(xlCellTypeVisible)

Btw, this post may help you in future: How to avoid using Select/Active statements

score 1 · Answer 2 · edited Dec 08 '19 at 07:05

1

ActiveCell.Columns("A:A").EntireColumn.Select
Selection.AutoFilter 'resets any current autofilter
Selection.AutoFilter Field:=1, Criteria1:="=~*  C", Operator:=xlFilterValues

and once filter is applied I usually use something like:

dim rng as range
set rng = ActiveSheet.cells.SpecialCells(xlCellTypeVisible)

that gets you all of the visible cells, which with a filter active, are only the ones that match the filter criteria.

edit

at the beginning do this:

dim numrows as long
dim numcolumns as long 

numrows = Cells.find("*", [A1], , , xlByRows, xlPrevious).Row
numcolumns = Cells.find("*", [A1], , , xlByColumns, xlPrevious).Column

then before filtering do this: set rng = Range("A1", Cells(numrows,numcolumns))

and then after filter, instead of Activesheet use: set rng = rng.cells.SpecialCells(xlCellTypeVisible) so that way it gets only the visible cells within the used range

edited Dec 08 '19 at 07:05

Davesexcel

6,896
2
27
42

answered Mar 17 '14 at 17:29

user1759942

1,322
4
14
33

This almost works! is there a way to set 'rng' to only highlight visible cells which contain a value? right now it highlights all of the cells in the worksheet. – Captain Who Mar 18 '14 at 15:00
This works great until I get to the Offset command. "rng = rng.Cells.SpecialCells(xlCellTypeVisible)" still is selects the entire worksheet. Is it possible to add a ">0" somewhere in the code? – Captain Who Mar 18 '14 at 17:02
What filter does is show you all rows where a particular column meets a particular criteria.. But filter shows the entire row. Filter does not show particular cells. So what the range is getting is all the rows that are shown by the filter. But again, the entire rows. Unfortunately there's no built in function to select only cells with stuff in them. The find function I guess finds individual cells, but again, filter finds rows, not cells. – user1759942 Mar 18 '14 at 17:31
What you could do, is copy rng, move it to another sheet, then use a loop to delete all blank cells. (If you use application.screenupdating = false it won't even take that log) so that way you'd be left with only cells with data... Make sure you include "xlShiftToLeft" after the delete so that the data shifts over – user1759942 Mar 18 '14 at 17:33

Change Loop to Auto Filter

2 Answers2

edit