Macro to find data in column

[meridius10]

I have set up a macro to find a particular number in a column:

Sub findobjectnumber()
    On Error GoTo z
    Dim x As Integer
    Dim y As Range
    Set y = Range("A:A")
    Set w = Range("A2")
    w.Select
    x = InputBox("Enter the object number below")
    y.Find(What:=x, _
    After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, _
    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False).Activate
    Exit Sub
z:
    MsgBox ("Object number does not exist. Try again.")
End Sub

This works well, but I was looking for some code to find duplicates as well so tried this:

Sub findonumbtest()
On Error GoTo z
Dim x As Integer
Selection.AutoFilter Field:=1
x = InputBox("Enter the object number below")
    Selection.AutoFilter Field:=1, Criteria1:=x, Operator:=xlAnd
Exit Sub
z:
    MsgBox ("Object number does not exist. Try again.")
End Sub

As my worksheet is password protected, this didn't work without

ActiveSheet.Unprotect ("pwd")

and

ActiveSheet.Protect ("pwd")

etc., which made the whole thing slower than it is. It's pretty rubbish code anyway. The first one does not find duplicates but works well.

The second one will come up with with error message 1004 ("You cannot use this command on a protected sheet" etc.) as long as

OnError GoTo z

etc. isn't included.

In Tools>Protection>Protect Sheet, I have allowed users to use AutoFilter, so I don't know what the problem is and perhaps there is some better code for this anyway.

[tigeravatar]

meridius10,

Could try something like this instead:

Sub FindNumbers()
    
    Dim UserInput As String, x As Long
    UserInput = vbNullString
    While UserInput = vbNullString
        UserInput = InputBox("Enter the object number below")
        If IsNumeric(UserInput) Then
            x = UserInput
        Else
            UserInput = vbNullString
        End If
    Wend
    
    Dim rngData As Range:       Set rngData = ActiveSheet.Range("A2:" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Address)
    Dim strMatches As String:   strMatches = vbNullString
    Dim aCell As Range
    For Each aCell In rngData
        If aCell.Value = x Then
            If strMatches = vbNullString Then
                strMatches = aCell.Address
            Else
                strMatches = strMatches & ", " & aCell.Address
            End If
        End If
    Next aCell
    
    If strMatches <> vbNullString Then
        ActiveSheet.Range(strMatches).Select
        MsgBox Selection.Cells.Count & " Matches found in these cell(s):" & Chr(10) & _
               Selection.Address
    Else
        MsgBox ("Object number does not exist. Try again.")
    End If
    
End Sub

Hope that helps,
~tigeravatar

[meridius10]

Brilliant - that's surpassed what I was after.

Now I must look at your code and see how I can approach a problem like this in a better way next time.