CODEWITHSUNDEEP
vbaexcelautofilter
Asim
Asim

Reputation: 105

Autofilter Macro, used to find a value in a range of data - how to display error message if no data is found

I have a spreadsheet with a list of employees. I want to run a macro that will filter on a specific employee when the employee number is entered in an input box. However if the number doesn't exist I want an error message to be displayed which gives the option of trying again.

My attempt is below:

Option Explicit

Sub AmendWeeklyHours()

'Find employee number
Dim EmployeeNumber As String
Dim Continue As Boolean
Dim aCell As Range

Continue = True

Do While Continue = True
    EmployeeNumber = InputBox("Please enter the employee number", "Enter Employee Number")

If StrPtr(EmployeeNumber) = 0 Then
        '~~> User pressed cancel
        Exit Sub
    Else
        '~~> User pressed OK with something filled
        If EmployeeNumber <> "" Then
            With ActiveSheet
                Set aCell = .Columns(3).Find(What:=EmployeeNumber, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not aCell Is Nothing Then
                    Selection.AutoFilter field:=3, Criteria1:=EmployeeNumber
                    Continue = False
                'If an invalid entry is entered
                Else
                    If MsgBox("You entered an invalid employee number - Try again?", _
                    vbYesNo + vbQuestion, "Search again?") = vbNo Then Exit Sub
                    Continue = False
                End If
            End With
        '~~> User pressed OK WITHOUT anything filled
        Else
            MsgBox "You didn't enter a value. Please enter the employee number or press cancel."
            Continue = True
        End If
    End If
Loop


'Find Week Ending Date
Dim WeekEnding As String
Dim Continue1 As Boolean
Dim bCell As Range

Continue1 = True

Do While Continue1 = True
    WeekEnding = InputBox("Please enter the week ending date", "Enter Week Ending Date")

If StrPtr(WeekEnding) = 0 Then
        '~~> User pressed cancel
        ActiveSheet.ShowAllData
        Exit Sub
    Else
        '~~> User pressed OK with something filled
        If WeekEnding <> "" Then
            With ActiveSheet
                Set bCell = .Columns(6).Find(What:=WeekEnding, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not bCell Is Nothing Then
                    Selection.AutoFilter field:=6, Criteria1:=WeekEnding
                    Continue1 = False
                Else
                'If an invalid entry is entered
                    If MsgBox("You entered an invalid week ending date - Try again?", _
                    vbYesNo + vbQuestion, "Search again?") = vbNo Then Exit Sub
                    Continue1 = False
                End If
            End With
        Else
            '~~> User pressed OK WITHOUT anything filled
            MsgBox "You didn't enter a value. Please enter the week ending date or press cancel."
            Continue1 = True
        End If
    End If
Loop

'Control + home
Dim Rng As Range
With ActiveSheet.AutoFilter
    Set Rng = .Range.Offset(1, 0).Resize(.Range.Rows.Count - 1)
    Rng.SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
End With

'Select hours column
ActiveCell.Offset(0, 4).Activate

'Enter hours
Dim NewHours As String
Dim Continue2 As Boolean

Continue2 = True

Do While Continue2 = True
NewHours = InputBox("Please enter the new hours", "Enter New Contracted Hours")

If StrPtr(NewHours) = 0 Then
        '~~> User pressed cancel
        ActiveSheet.ShowAllData
        Exit Sub

        'User pressed OK WITH something filled
        ElseIf NewHours <> "" Then
        ActiveCell = NewHours
        Continue2 = False
    Else
        '~~> User pressed OK WITHOUT anything filled
        MsgBox "You didn't enter a value. Please enter the number of hours or press cancel."
        Continue2 = True
End If
Loop

'Completion message
MsgBox ("Hours have been amended")

'Show all data
ActiveSheet.ShowAllData    
End Sub

Revised code above

Upvotes: 1

Views: 3581

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149325

Here is one way if you want the user to enter the number

Option Explicit

Sub Sample()
    Dim EmployeeNumber As String
    Dim Continue As Boolean
    Dim aCell As Range

    Continue = True

    Do While Continue = True
        EmployeeNumber = InputBox("Please enter the assignment number")

        If EmployeeNumber <> "" Then             
            With Sheets("Sheet1")
                '~~> Change .Columns(1) to the relevant range
                Set aCell = .Columns(1).Find(What:=EmployeeNumber, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not aCell Is Nothing Then
                    '~~> Rest of your code
                    'Selection.AutoFilter field:=3, Criteria1:=FindVal1
                Else
                    If MsgBox("You entered an invalid employee number - Try again?", _
                    vbYesNo + vbQuestion, "Search again?") = vbNo Then _
                    Continue = False
                End If
            End With
        Else
            Continue = False
        End If
    Loop
End Sub

FOLLOWUP

Sub Sample()
    Dim EmployeeNumber As String
    Dim Continue As Boolean
    Dim aCell As Range

    Continue = True

    Do While Continue = True
        EmployeeNumber = InputBox("Please enter the assignment number")

        If StrPtr(EmployeeNumber) = 0 Then
            '~~> User pressed cancel
            Exit Sub
        Else
            '~~> User pressed OK with something filled
            If EmployeeNumber <> "" Then
                With Sheets("Sheet1")
                    Set aCell = .Columns(3).Find(What:=EmployeeNumber, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

                    If Not aCell Is Nothing Then
                        Selection.AutoFilter field:=3, Criteria1:=EmployeeNumber
                        Continue = False
                    Else
                        If MsgBox("You entered an invalid employee number - Try again?", _
                        vbYesNo + vbQuestion, "Search again?") = vbNo Then _
                        Continue = False
                    End If
                End With
            '~~> User pressed OK WITHOUT anything filled
            Else
                Msgbox "You didn't enter anything. Please enter the employee number in the next box which pops up"
                Continue = True
            End If
        End If
    Loop
End Sub

Upvotes: 3

Related Questions