Darren Smith
Well-known Member
- Joined
- Nov 23, 2020
- Messages
- 631
- Office Version
- 2019
- Platform
- Windows
Hi All,
This code will not work can`t work out why?
Sorry to say but this is very urgent...
This part fails it says Error 1004 "Autofilter method of Range Class Failed"
This code will not work can`t work out why?
Sorry to say but this is very urgent...
This part fails it says Error 1004 "Autofilter method of Range Class Failed"
VBA Code:
With rngFull
.AutoFilter Field:=lngDateCol, _
Criteria1:=">=" & StartDate, _
Criteria2:="<=" & EndDate
VBA Code:
Public Sub PromptUserForInputDates()
Dim strStart As String, strEnd As String, strPromptMessage As String
strStart = InputBox("Please enter the Current JobNos. start date")
If Not IsDate(strStart) Then
strPromptMessage = "Oops! It looks like your entry is not a valid " & _
"date. Please retry with a valid date..."
MsgBox strPromptMessage
Exit Sub
End If
strEnd = InputBox("Please enter the Current JobNos. end date")
If Not IsDate(strStart) Then
strPromptMessage = "Oops! It looks like your entry is not a valid " & _
"date. Please retry with a valid date..."
MsgBox strPromptMessage
Exit Sub
End If
Call CreateSubsetWorksheet(strStart, strEnd)
End Sub
Public Sub CreateSubsetWorksheet(StartDate As String, EndDate As String)
Dim wksData As Worksheet, wksTarget As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long
Dim rngFull As Range, rngResult As Range, rngTarget As Range
Set wksData = ThisWorkbook.Worksheets("TGS JOB RECORD")
lngDateCol = 53
lngLastRow = LastOccupiedRowNum(wksData)
lngLastCol = LastOccupiedColNum(wksData)
With wksData
Set rngFull = wksData.Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
End With
With rngFull
.AutoFilter Field:=lngDateCol, _
Criteria1:=">=" & StartDate, _
Criteria2:="<=" & EndDate
If wksData.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "Oops! Those dates filter out all data!"
wksData.AutoFilterMode = False
If wksData.FilterMode = True Then
wksData.ShowAllData
End If
Exit Sub
Else
Set rngResult = .SpecialCells(xlCellTypeVisible)
Set wksTarget = ThisWorkbook.Worksheets.Add("Current Jobs")
Set rngTarget = wksTarget.Cells(1, 1)
rngResult.Copy Destination:=rngTarget
End If
End With
wksData.AutoFilterMode = False
If wksData.FilterMode = True Then
wksData.ShowAllData
End If
MsgBox "Data transferred!"
End Sub
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
End Function
