Userform Overdue Calculation

[nparsons75]

Really hope someone can assist and hope I can explain this well enough.

I have a userform which will record tasks. I add numerous data to each record and then submit the record into the spreadsheet via the userform.

On the userform I have a field (textbox) that will contain a date (due date of the task).

I have a macro that runs through a command button which looks for all tasks which are overdue (due dates which have been passed, less than TODAY).

On the userform I have a listbox which displays my records. I use an advanced filter to do this.

I need to be able to show in the listbox all records that are overdue.

Im hoping someone can assist, it will be a great help, appreciate any help.

Thanks,

 

[pbornemeier]

On the userform I have a listbox which displays my records. I use an advanced filter to do this.
I need to be able to show in the listbox all records that are overdue.

Can you modify the advanced filter to show only records with a due date past?

 

[nparsons75]

That is exactly what I want to do. I just cant seem to get it to work. My listbox is taken from the results of the advanced filter. I just cant seem to get it to work, I am frustratingly close.

 

[pbornemeier]

Post the code that copies from the advanced filter to the listbox.

 

[nparsons75]

Hi, sorry for the day, just got to PC. Here is the code for the userfom. The code for the advanced filter is in the next post.

Option Explicit'Private variables
Dim cNum As Integer
Dim X As Integer
Private Sub cmdLookup_Click()
'call lookup macro
Lookup
End Sub
Private Sub Reg17_Change()
If IsDate(Me.Reg17) Then Me.Reg20 = _
"" & Format(DateDiff("d", Now(), Me.Reg17), "#,###")
End Sub
Sub Lookup()
'declare the variables
Dim Due As Variant
'error statement
On Error GoTo errHandler:
'clear the listbox
lstLookup.RowSource = ""
'set the variable
Due = Me.cboStart.Value
'if "New" or "Once" is selected run a different filter
If Me.cboStart.Value = "Once" Or Me.cboStart.Value = "New" Then
Sheet2.Range("X7").Value = Me.cboStart.Value
AdvFilter_Once
'if the results are nil then clear the rowsource to avoid an error
If Sheet2.Range("AD7").Value = "" Then
lstLookup.RowSource = ""
Else
'add range to rowsource if range has values
lstLookup.RowSource = "Filter_Staff"
End If
Exit Sub
End If
'if no date selected for criteria
With Sheet2
If Me.cboStart = "" Then
.Range("Y7").Value = ""
.Range("Z7").Value = ""
.Range("AA7").Value = Me.txtLookup
.Range("AB7").Value = Me.cboDepartment
'if date is selected
Else
.Range("Z7").Value = "=""<""&TODAY()" & "+" & Due
.Range("Y7").Value = "="">""&TODAY()"
.Range("AA7").Value = Me.txtLookup
.Range("AB7").Value = Me.cboDepartment
End If
End With
'run the filter
AdvFilter
'if the results are nil then clear the rowsource to avoid an error
If Sheet2.Range("AD7").Value = "" Then
lstLookup.RowSource = ""
Else
'add range to rowsource if range has values
lstLookup.RowSource = "Filter_Staff"
End If
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdOverdue_Click()
'error statement
On Error GoTo errHandler:
'clear the listbox
lstLookup.RowSource = ""
'clear controls
Me.txtLookup.Value = ""
Me.cboStart.Value = ""
'add department and date range to criteria
With Sheet2
.Range("Z7").Value = ""
.Range("AA7").Value = ""
.Range("AB7").Value = Me.cboDepartment.Value
.Range("Y7").Value = "=""<=""&TODAY()"
End With
'run the filter
AdvFilter
'check for value and adjust rowsource to avoid an error
If Sheet2.Range("AD7").Value = "" Then
lstLookup.RowSource = ""
Else
lstLookup.RowSource = "Filter_Staff"
End If
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
Dim ID As String
Dim I As Integer
Dim findvalue
'error block
On Error GoTo errHandler:
'get the select value from the listbox
For I = 0 To lstLookup.ListCount - 1
If lstLookup.Selected(I) = True Then
'set the listbox column
ID = lstLookup.List(I, 19)
End If
Next I
'find the value in the range
Set findvalue = Sheet2.Range("V:V").Find(What:=ID, LookIn:=xlValues).Offset(0, -19)
'add the values to the userform controls
Me.Reg1.Value = findvalue
Me.Reg2.Value = findvalue.Offset(0, 1)
Me.Reg3.Value = findvalue.Offset(0, 2)
Me.Reg4.Value = findvalue.Offset(0, 3)
Me.Reg5.Value = findvalue.Offset(0, 4)
Me.Reg6.Value = findvalue.Offset(0, 5)
Me.Reg7.Value = Format(findvalue.Offset(0, 6), "dd/mm/yy")
Me.Reg8.Value = findvalue.Offset(0, 7)
Me.Reg9.Value = findvalue.Offset(0, 8)
Me.Reg10.Value = findvalue.Offset(0, 9)
Me.Reg11.Value = findvalue.Offset(0, 10)
Me.Reg12.Value = findvalue.Offset(0, 11)
Me.Reg13.Value = findvalue.Offset(0, 12)
Me.Reg14.Value = findvalue.Offset(0, 13)
Me.Reg15.Value = findvalue.Offset(0, 14)
Me.Reg16.Value = findvalue.Offset(0, 15)
Me.Reg17.Value = Format(findvalue.Offset(0, 16), "dd/mm/yy")
Me.Reg18.Value = findvalue.Offset(0, 17)
Me.Reg19.Value = findvalue.Offset(0, 18)
Me.Reg99.Value = findvalue.Offset(0, 19)


'cNum = 20
'For X = 1 To cNum
'Me.Controls("Reg" & X).Value = findvalue
'Set findvalue = findvalue.Offset(0, 1)
'Next
'disable the controls to make the user select an option
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdAdd_Click()
'declare the valiable
Dim nextrow As Range
'error handler
On Error GoTo errHandler:
Application.ScreenUpdating = False
'force user to click the option button
Me.Reg99.Value = Sheet2.Range("J2").Value + 1
If Me.Reg3.Enabled = False Then
MsgBox "You need to click the Add Option Button"
Exit Sub
End If

'THIS BELOW MAY CAUSE AN ISSUE

'set the next row in the database
Set nextrow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'check for values in all controls
If Me.Reg8.Value = "New" Or Me.Reg8.Value = "Once" Then
For X = 1 To 9
If Me.Controls("Reg" & X).Value = "" Then
MsgBox "You need to add the skill and first and last names"
Exit Sub
End If
Next
Else
For X = 1 To 9
If Me.Controls("Reg" & X).Value = "" Then
MsgBox "Please ensure boxes 1 to 9 have been completed"
Exit Sub
End If
Next
End If
'check for duplicate staff
If WorksheetFunction.CountIf(Sheet2.Range("E:E"), Me.Reg3.Value) > 0 Then
MsgBox "This staff member already exists"
Exit Sub
End If

'HERE
'add value to the next row in the database
nextrow = Reg1.Value
nextrow.Offset(0, 1) = Reg2.Value
nextrow.Offset(0, 2) = Reg3.Value
nextrow.Offset(0, 3) = Reg4.Value
nextrow.Offset(0, 4) = Reg5.Value
nextrow.Offset(0, 5) = Reg6.Value
nextrow.Offset(0, 7) = Reg8.Value
nextrow.Offset(0, 8) = Reg9.Value
nextrow.Offset(0, 9) = Reg10.Value
nextrow.Offset(0, 10) = Reg11.Value
nextrow.Offset(0, 11) = Reg12.Value
nextrow.Offset(0, 12) = Reg13.Value
nextrow.Offset(0, 13) = Reg14.Value
nextrow.Offset(0, 14) = Reg15.Value
nextrow.Offset(0, 15) = Reg16.Value
nextrow.Offset(0, 17) = Reg18.Value
nextrow.Offset(0, 18) = Reg19.Value
nextrow.Offset(0, 19) = Reg99.Value


'format the date values on the worksheet
With nextrow
.Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy")
End With
'nextrow.Offset(0, 8) = Reg8.Value
With nextrow
.Offset(0, 16).Value = Format(Reg17.Value, "mm/dd/yy")
End With
nextrow.Offset(0, 19) = Reg99.Value
'HERE

'sort the database
Sortit
'set the criteria for the filter to show the department
With Sheet2
.Range("Z7").Value = ""
.Range("AA7").Value = ""
.Range("AB7").Value = Me.Reg5.Value
.Range("Y7").Value = ""
End With
'run the filter
AdvFilter
'add the rowsource to the listbox
lstLookup.RowSource = "Filter_Staff"
'clear the controls
For X = 1 To 20
Me.Controls("Reg" & X).Value = ""
Next
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdTraining_Click()
'declare the variables
Dim cNum As Integer
Dim nextrow As Range
Dim MyCell As Range
Dim rng As Long
'error handling
On Error GoTo errHandler:
'check for duplicates
'rng = Sheet2.Cells(Rows.Count, "E").End(xlUp).Row
'For Each MyCell In Sheet2.Range("E7:E" & rng)
'If MyCell = Me.Reg3.Value And MyCell.Offset(0, 2).Value = Me.Reg6.Value Then
'MsgBox "This training already exists for this staff member"
Exit Sub
End If
Next MyCell
'check for values
Me.Reg99.Value = Sheet2.Range("J2").Value + 1
If Reg1.Value = "" Or Reg3.Value = "" Then
MsgBox "There is not data to add"
Exit Sub
End If
'check that the date is a date
If Not IsDate(Me.Reg7) Then
MsgBox "Completed date must be a date format"
Exit Sub
End If


'find the next row to add data to USE THIS TO CHECK DATA HAS BEEN ADDED IN FIELDS


Set nextrow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'check for values in the controls
If Me.Reg6.Value = "" Or Me.Reg7.Value = "" Or Me.Reg8.Value = "" Then
MsgBox "You need to add all data"
Exit Sub
End If
'clear the listbox
lstLookup.RowSource = ""
'add the values to the database
nextrow = Reg1.Value
nextrow.Offset(0, 1) = Reg2.Value
nextrow.Offset(0, 2) = Reg3.Value
nextrow.Offset(0, 3) = Reg4.Value
nextrow.Offset(0, 4) = Reg5.Value
nextrow.Offset(0, 5) = Reg6.Value
nextrow.Offset(0, 7) = Reg8.Value
nextrow.Offset(0, 8) = Reg9.Value
nextrow.Offset(0, 9) = Reg10.Value
nextrow.Offset(0, 10) = Reg11.Value
nextrow.Offset(0, 11) = Reg12.Value
nextrow.Offset(0, 12) = Reg13.Value
nextrow.Offset(0, 13) = Reg14.Value
nextrow.Offset(0, 14) = Reg15.Value
nextrow.Offset(0, 15) = Reg16.Value
nextrow.Offset(0, 17) = Reg18.Value
nextrow.Offset(0, 18) = Reg19.Value
nextrow.Offset(0, 19) = Reg99.Value




'format the date values on the worksheet
With nextrow
.Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy")
End With
'nextrow.Offset(0, 8) = Reg8.Value
With nextrow
.Offset(0, 16).Value = Format(Reg17.Value, "mm/dd/yy")
End With
nextrow.Offset(0, 19) = Reg99.Value


'sort the database
Sortit
'run the filter
AdvFilter
'refresh the rowsource in the listbox
lstLookup.RowSource = ""
lstLookup.RowSource = "Filter_Staff"
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Private Sub cmdEdit_Click()
'declare the variables
Dim findvalue As Range
Dim cNum As Integer
'error handling
On Error GoTo errHandler:
'check for values
If Reg1.Value = "" Or Reg3.Value = "" Then
MsgBox "There is not data to edit"
Exit Sub
End If
'check to see if the date is entered
If Not IsDate(Me.Reg7) Then
MsgBox "Completed date must be a date format"
Exit Sub
End If
'clear the listbox
lstLookup.RowSource = ""
'find the row to edit
Set findvalue = Sheet2.Range("V:V").Find(What:=Reg99, LookIn:=xlValues).Offset(0, -19)




'update the values
findvalue = Reg1.Value
findvalue.Offset(0, 1) = Reg2.Value
findvalue.Offset(0, 2) = Reg3.Value
findvalue.Offset(0, 3) = Reg4.Value
findvalue.Offset(0, 4) = Reg5.Value
findvalue.Offset(0, 5) = Reg6.Value


findvalue.Offset(0, 7) = Reg8.Value
findvalue.Offset(0, 8) = Reg9.Value
findvalue.Offset(0, 9) = Reg10.Value
findvalue.Offset(0, 10) = Reg11.Value
findvalue.Offset(0, 11) = Reg12.Value
findvalue.Offset(0, 12) = Reg13.Value
findvalue.Offset(0, 13) = Reg14.Value
findvalue.Offset(0, 14) = Reg15.Value
findvalue.Offset(0, 15) = Reg16.Value


findvalue.Offset(0, 17) = Reg18.Value
findvalue.Offset(0, 18) = Reg19.Value
findvalue.Offset(0, 19) = Reg99.Value


'format date values
With findvalue
.Offset(0, 6).Value = Format(Reg7.Value, "mm/dd/yy")
End With
'findvalue.Offset(0, 8) = Reg8.Value
With findvalue
.Offset(0, 16).Value = Format(Reg17.Value, "mm/dd/yy")
End With
findvalue.Offset(0, 19) = Reg99.Value


'run the filter
AdvFilter
'add the new values to the listbox
lstLookup.RowSource = "Filter_Staff"
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & _
"The error number is: " & Err.Number & vbCrLf & _
Err.Description & vbCrLf & "Please notify the administrator"
End Sub
Private Sub cmdDelete_Click()
'declare the variables
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
Dim cNum As Integer
'error statement
On Error GoTo errHandler:
'check for values
If Reg1.Value = "" Or Reg3.Value = "" Then
MsgBox "There is not data to delete"
Exit Sub
End If
'give the user a chance to change their mind
cDelete = MsgBox("Are you sure that you want to delete this training", vbYesNo + vbDefaultButton2, "Are you sure??")
If cDelete = vbYes Then
'find the row
Set findvalue = Sheet2.Range("V:V").Find(What:=Reg99, LookIn:=xlValues)
findvalue.EntireRow.Delete
End If
'clear the controls
cNum = 20
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
'run the filter
AdvFilter
'add the values to the listbox
lstLookup.RowSource = ""
lstLookup.RowSource = "Filter_Staff"
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Sub Setit()
'disable,clear values and change the back color of all controls
cNum = 20
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Next
'clear the criteria range
With Sheet2
.Range("Z7").Value = ""
.Range("AA7").Value = ""
.Range("AB7").Value = ""
.Range("Y7").Value = ""
End With
'clear the listbox
lstLookup.RowSource = ""
'clear the controls
With Me
.txtLookup.Value = ""
.cboDepartment.Value = ""
.cboStart.Value = ""
End With
End Sub
Private Sub Reg7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'check for date value
Me.Reg7 = Format(Me.Reg7, "dd/mm/yy")
If Not IsDate(Me.Reg7) Then
MsgBox "Completed date must be a date format"
Me.Reg7.Value = ""
Exit Sub
End If
End Sub
'Private Sub Reg17_Change()
'add values to criteria
'Me.Reg17.Value = Format(Me.Reg17.Value, "mm/dd/yy")
'With Sheet3
'.Range("O7").Value = Format(Me.Reg7.Value, "mm/dd/YY")
'.Range("P7").Value = Me.Reg8.Value
'End With
'Me.Reg17.Value = Format(Sheet3.Range("Q7").Value, "dd/mm/yy")
'End Sub
'Private Sub Reg17_Change()
'Me.Reg17 = Format(Me.Reg17, "dd/mm/yy")
'End Sub


Private Sub UserForm_Initialize()
'format the control
Me.Reg7 = Format(Me.Reg7, "dd/mm/yy")
Me.Reg17 = Format(Me.Reg17, "dd/mm/yy")
'clear the listbox
Me.lstLookup.RowSource = ""
AdvFilter
With Application
Me.Left = .Left
Me.Top = .Top
Me.Height = .Height
Me.Width = .Width
End With
End Sub
Private Sub cmdClear_Click()
'call macro Setit to clear values
Setit
End Sub
Private Sub cmdClear2_Click()
'call macro Setit to clear values
Setit
End Sub
Private Sub cmdClose_Click()
'close userform
Unload Me
End Sub

 

[nparsons75]

Really appreciate any help, struggling with this one. Im sure its an easy one too.

Code for advanced filter

Sub Interface()'sheet navigation
    Sheet1.Select
    Sheet1.Range("A1").Select
End Sub
Sub Data()
'sheet navigation
    Sheet2.Select
    Sheet2.Range("A1").Select
End Sub
Sub Lists()
'sheet navigation
    Sheet3.Select
    Sheet3.Range("A1").Select
End Sub
Sub ShowMe()
'show userform
    FrmTraining.Show
End Sub
Sub ShowMe2()
'show userform
    frmreport.Show
End Sub
Sub Sortit()
'sort the data
    With Sheet2
        .Range("C7:V10000").Sort Key1:=.Range("D7"), Order1:=xlAscending, Header:=xlNo
    End With
End Sub
Sub AdvFilter()
'error statement
On Error GoTo errHandler:
'run the advanced filter
With Sheet2
.Range("C6").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheet2.Range("Y6:AB7"), CopyToRange:=Sheet2.Range("AD6:AW6"), Unique:=False
End With
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Sub AdvFilter_Once()
'error statement
    On Error GoTo errHandler:
'run the advanced filter
    With Sheet2
        .Range("C6").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheet2.Range("X6:X7"), CopyToRange:=Sheet2.Range("AD6:AW6"), Unique:=False
    End With
'error block
    On Error GoTo 0
    Exit Sub
errHandler::
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"
End Sub
Sub PrintPDFAll()
'turn off screen updating
Dim Opendialog
Dim MyRange As Range
Application.ScreenUpdating = False
'open dialog and set file type
Opendialog = Application.GetSaveAsFilename("", filefilter:="PDF Files (*.pdf), *.pdf", _
Title:="LUR Training Report")
'if no value is added for file name
If Opendialog = False Then
MsgBox "The operation was not successful"
Exit Sub
End If
'set the named range for the PDF print area
Sheet2.Select
With Sheet2
.Range("W1:AH" & Cells(Rows.Count, "W").End(xlUp).Row).Name = "PDFRng"
End With
'set range
Set MyRange = Sheet2.Range("PDFRng")
Sheet2.PageSetup.PrintArea = "PDFRng"
'create the PDF
On Error Resume Next
MyRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Opendialog, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'error handler
On Error GoTo 0
'clear the page breaks
ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
Sheet1.Select
End Sub
Sub Tabs()
    ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs
End Sub

 

[pbornemeier]

Tough to read with no indents. Please use Code Tags (see link in my sig) to post with indents intact.

A filtered list is still visible to the range commands. I can see 2 ways to work around it:

FillListBoxWithVisibleRowsFromNamedRange will populate a listbox with the visible rows in a filtered named range.
CopyVisibleRowsToAnotherSheet will copy the filtered rows to another sheet and you can define "Filter_Staff" as that sheet

Sub FillListBoxWithVisibleRowsFromNamedRange()

    'Named Range "AllRows = "=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),COUNTA(Sheet1!$1:$1))"
    '  dynamic to hold all of the data and handle changes
    
    Dim rngAll As Range
    Dim x As Variant
    Dim aryRows, aryCols, aryList()
    Dim lColCount As Long
    Dim lRowIndex As Long
    Dim lColIndex As Long
    
    'Late Binding for New DataObject
    Dim objMyData As Object
    Set objMyData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
    Set rngAll = Range("AllRows")
    lColCount = rngAll.Columns.Count
    If Application.WorksheetFunction.Subtotal(3, Columns(1)) > 1 Then
        ActiveSheet.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
        DoEvents 'or next line throws runtime error
        objMyData.GetFromClipboard
        x = objMyData.GetText   'tab separates columns, CRLF after last cell data
        aryRows = Split(x, vbCrLf)
        ReDim Preserve aryList(UBound(aryRows) - 1, lColCount - 1)
        
        For lRowIndex = LBound(aryRows) To UBound(aryRows) - 1
            aryCols = Split(aryRows(lRowIndex), vbTab)
            UserForm1.ListBox1.AddItem (lRowIndex)
            For lColIndex = LBound(aryCols) To UBound(aryCols)
                UserForm1.ListBox1.List(lRowIndex, lColIndex) = aryCols(lColIndex)
            Next
        Next
        UserForm1.Show
    End If
    Set objMyData = Nothing
    Set rngAll = Nothing
    
End Sub

Sub CopyVisibleRowsToAnotherSheet()

    'Named Range "AllRows = "=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),COUNTA(Sheet1!$1:$1))"
    
    Dim rngAll As Range
    Set rngAll = Range("AllRows")
    If Application.WorksheetFunction.Subtotal(3, Columns(1)) > 1 Then
        Worksheets("Visible").Cells.Clear
        ActiveSheet.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Visible").Range("A1")
    End If
End Sub

 

[Legacy 452653]

Hi,

I have almost completed a Staff Tracker Database and in the Sub Lookup ()
indicates

Due = Me.cboStart.Value However im getting a compile error:Invalid use of Me Keyword everytime I run the VBA module.

Can you shed some light into this error. I give you almost identical VBA code below
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Due = Me.cboStart.Value
'if "New" or "Once" is selected run a different filter
If Me.cboStart.Value = "Once" Or Me.cboStart.Value = "New" Then
Sheet2.Range("N7").Value = Me.cboStart.Value
AdvFilter_Once
'if the results are nil then clear the rowsource to avoid an error
If Sheet2.Range("T7").Value = "" Then
lstLookup.RowSource = ""
Else
'add range to rowsource if range has values
lstLookup.RowSource = "Filter_Staff"
End If
Exit Sub
End If
'if no date selected for criteria
With Sheet2
If Me.cboStart = "" Then
.Range("O7").Value = ""
.Range("P7").Value = ""
.Range("Q7").Value = Me.txtLookup
.Range("R7").Value = Me.cboDepartment

Please indicate why this error keeps on coming up

Thanks
Steve
[/FONT]​

 

[pbornemeier]

That error is usually caused by using the me qualifier when the code is located in a standard or class module.
On a worksheet or chart code page me it taken to mean that page
In a form's codepage, me is taken to mean the form

If your code is in a standard module specify the worksheet instead of me

For the code you showed, change me to Sheet2

For these lines

With Sheet2
If Me.cboStart = "" Then

change Me.cboStart

to

.cboStart

 

[Legacy 452653]

Thanks Phil,

But on Due = Sheet2.cboStart.Value the cboStart now it indicates
Compile Error:
Method or Data member not found.

Unless I have misread your message, I have changed in that procedure all Me to Sheet2.

Im also wondering about this staff training tracker from PConline learning when selecting cbo for frequency it shows "New" or "Once", but I cant get numbers filtered down into my list box. This is driving me crazy. The tutorial has the person selecting numerical and be able to filter not only new and once but all the frequency numbers.

So, can you please tell what Im missing here in this module, otherwise im just going to do advanced filtering for the 2 cbo's and txtsearch with a long macro filtering.

Thanks Steve