CODEWITHSUNDEEP
vbaexcel
r.vincent
r.vincent

Reputation: 1

Autofilter returns no data

So I am trying to create a macro that will autofilter a range of data (in Column E) for predefined headers that start at Column N. So the autofilter runs filtering the data in column e for the title in column n, it then copies and pastes that data into column n, then loops and does the same for column o and so on. The issue I am having, is if the filter runs, and there are no matches for the autofilter it creates an error. Strangely, I used if error go to, and for one blank column it works perfectly, however if there are two blank columns as such, then it fails the second time around. I have posted the code below. Does anyone have any suggestions?

Sub Siglum_Sorter()

Sheets("Operator Database").Select


Dim rRng1 As Range
Dim rRng2 As Range
Dim fCol As Long
fCol = 13

Set rRng1 = Range("E:E")
Set rRng2 = Range("G2:G100")
Do

On Error GoTo SkipToHere

fCol = fCol + 1
rCrit = Cells(1, fCol)

MsgBox "cells   " & fCol & "    " & rCrit

With rRng1
.AutoFilter field:=1, Criteria1:=rCrit, Operator:=xlOr

rRng2.SpecialCells(xlCellTypeVisible).Copy 'or do something else
End With

Cells(2, fCol).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

SkipToHere:

Loop Until IsEmpty(Cells(1, fCol))

End Sub

Upvotes: 0

Views: 198

Answers (2)

kschindl
kschindl

Reputation: 233

I would just add a a check after the filter to see if the last visible row is the data headers. If so, don't copy the data

Dim lrow_data as long
lrow_data = ThisWorkbook.Sheets("Sheet1").Cells(Cells.Rows.Count,1).End(xlUp) 'or change it to your needed sheet

If lrow_data = 1 Then
    'Do Nothing, last row is the headers
    Else
    rRng2.SpecialCells(xlCellTypeVisible).Copy
End If

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166835

Dim rngF As Range

With rRng1.AutoFilter field:=1, Criteria1:=rCrit, Operator:=xlOr

Set rngF = Nothing
On Error Resume Next 'ignore any error if no visible cells
Set rngF = rRng2.SpecialCells(xlCellTypeVisible)
On Error Goto 0

If Not rngF Is Nothing Then
    'do something with rngF
Else
    'no visible cells...
End If

Upvotes: 1

Related Questions