Use months in this code rather than dates

[Darren Smith]

Afternoon,

Trying to use months rather than dates in this code.
Any ideas on how to alter the code?

Public Sub PromptUserForInputDates()
    
   
    
    Dim strStart As String, strEnd As String, strPromptMessage As String

    strStart = InputBox("Please enter the Current JobNos.First Month")
    

    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. Last Month")
    

    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)

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:=">=" & CLng(CDate(StartDate)), _
                    Criteria2:="<=" & CLng(CDate(EndDate)), Operator:=xlAnd
                    

        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
              wksTarget.Name = "Current Jobs"
            Set rngTarget = wksTarget.Cells(1, 1)
            rngResult.Copy Destination:=rngTarget
            wksTarget.Columns.AutoFit

        End If
    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

 

[Darren Smith]

Don`t worry about above

 

[smozgur]

Don`t worry about above

Sure, we wouldn't worry about it but please leave it unmarked (because there is no answer posted to be marked as a solution), or better if you can post your solution to help future readers having a similar problem. Then you can mark your own post as the solution.