B
bpotter
I keep getting an error "the extract range has missing or illegal
field name"
I am filtering out the dates. I also have route numbers in column b
and when I change the code to filter this column it works fine. So I
think it is trying to look at the formula in this column and not the
values.
I think I have tried everything and at my wits end. Please help before
I throw this computer out the window.
I have marked the lines where I am getting the error message w/ *.
Sub Autofilter()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim FieldNum As Integer
Set ws1 = Sheets("Plunger")
Set rng = ws1.Range("A16:T" & Rows.Count)
FieldNum = 16
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set ws2 = Worksheets.Add
* With ws2
* rng.Columns(FieldNum).AdvancedFilter _
* Action:=xlFilterCopy, _
* CopyToRange:=.Range("A1"), Unique:=True
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = Format(cell.Value, "mm-yy")
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0
ws1.AutoFilterMode = False
rng.Autofilter Field:=FieldNum, Criteria1:="=" &
cell.Value
ws1.Autofilter.Range.Copy
With WSNew.Range("A1")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
ws1.AutoFilterMode = False
Next cell
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub
field name"
I am filtering out the dates. I also have route numbers in column b
and when I change the code to filter this column it works fine. So I
think it is trying to look at the formula in this column and not the
values.
I think I have tried everything and at my wits end. Please help before
I throw this computer out the window.
I have marked the lines where I am getting the error message w/ *.
Sub Autofilter()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim FieldNum As Integer
Set ws1 = Sheets("Plunger")
Set rng = ws1.Range("A16:T" & Rows.Count)
FieldNum = 16
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set ws2 = Worksheets.Add
* With ws2
* rng.Columns(FieldNum).AdvancedFilter _
* Action:=xlFilterCopy, _
* CopyToRange:=.Range("A1"), Unique:=True
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = Format(cell.Value, "mm-yy")
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0
ws1.AutoFilterMode = False
rng.Autofilter Field:=FieldNum, Criteria1:="=" &
cell.Value
ws1.Autofilter.Range.Copy
With WSNew.Range("A1")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
ws1.AutoFilterMode = False
Next cell
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub