Some reason my filter does not work

Darren Smith

Well-known Member
Joined
Nov 23, 2020
Messages
608
Office Version
  1. 2019
Platform
  1. Windows
This filter is to filter the months (In column 6) on a sheet then copy the result over to another sheet but it won`t filter the first sheet?
Do I need to use a count x to count all filled-in cells in the column or do I need to use the date column (In Column 3) to filter?

VBA Code:
Option Explicit
Public Sub PromptUserForInputDates()
    
   
    
    Dim strStart As String, strEnd As String, strPromptMessage As String
    Dim wksData As Worksheet
    Dim x As Integer
    Dim Lastrow As Long
    Dim Months As Object
    
    strStart = InputBox("Please enter the Current JobNos.First Month")
    
    Set wksData = ThisWorkbook.Worksheets("TGS JOB RECORD")
    Lastrow = wksData.Range("A" & Rows.Count).End(xlUp).Row
    Set Months = wksData.Range("F2:F" & Lastrow)
    
    For x = 2 To 6

    If Cells(x, 6).Value = 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
    Next x
    
strEnd = InputBox("Please enter the  Current JobNos. Last Month")
    
      For x = 2 To 6
      
    If Cells(x, 6).Value = strEnd 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
    Next x
    Call CreateSubsetWorksheet(strStart, strEnd)
    
End Sub

Public Sub CreateSubsetWorksheet(StartDate As String, EndDate As String)

TurnOff

ThisWorkbook.Worksheets("Current Jobs").Delete

    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, JobNotDone As Range
    

    Set wksData = ThisWorkbook.Worksheets("TGS JOB RECORD")
    lngDateCol = 6
    Set JobNotDone = wksData.Range("A2").CurrentRegion
    
    
    lngLastRow = LastOccupiedRowNum(wksData)
    lngLastCol = LastOccupiedColNum(wksData)
    With wksData
        Set rngFull = wksData.Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
    End With
    
    wksData.AutoFilterMode = False

JobNotDone.AutoFilter field:=5, Criteria1:="="
    
    With rngFull
                   .AutoFilter field:=lngDateCol, _
                    Criteria1:=">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate

            Set rngResult = .SpecialCells(xlCellTypeVisible)
            
              Set wksTarget = ThisWorkbook.Worksheets.Add
              wksTarget.Name = "Current Jobs"
            Set rngTarget = wksTarget.Cells(1, 1)
            rngResult.Copy Destination:=rngTarget
            wksTarget.Columns.AutoFit
      End With
    
     
    
    wksData.AutoFilterMode = False
    If wksData.FilterMode = True Then
        wksData.ShowAllData
    End If
    
MsgBox "Data transferred!"

TurnOn

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

Sub TurnOff()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

End Sub
Sub TurnOn()

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,772
Office Version
  1. 365
Platform
  1. Windows
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Trying to filter a column - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 

Forum statistics

Threads
1,143,909
Messages
5,721,465
Members
422,363
Latest member
Bogus_Potatoes

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top