CODEWITHSUNDEEP
vbaexcel
Alan Treanor
Alan Treanor

Reputation: 159

Need it to search through duplicate records until finds criteria

I'm still quite new to VBA and struggling with the following code!

What I am trying to do is have the search function look through all cells within column 1 and find the criteria of Cell 1 matches PickerName2.Text and offset cell 5 is <>0 and then offset cell 6 = Blank

The problem I have is there a duplicates all the way down column 1 and as soon as it finds the matching name to PickerName2 Then it checks the offset cells 5 & 6 and as these don't match the criteria it gives the message they aren't currently picking.

This is even though further down the sheet there is a record that matches the criteria. I want it to look through all records until it find the criteria or if it has checked all populated cells in column A and nothing matches then it will give the message that they aren't currently picking.

I do hope someone can help :-)

Al

Private Sub CommandButton3_Click()

Dim iRow As Long
    Dim ws As Worksheet
    Dim strSearch As String
    Dim aCell As Range
    Dim rng As Range, i As Long

    '~~> Set the sheet where you want to search the IMEI
    Set ws = Sheets("PickData")

        With ws
        '~~> Get the value which you want to search
        strSearch = PickerName2.Text

        '~~> Column A is Column 1 so Column B is 2. This is where we are searching
        '~~> xlWhole is used in the code below so that we find a complete match
        '~~> xlPart is supposed to be used when you are finding a partial match.
        Set aCell = .Columns(1).Find(What:=strSearch, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)


            '~~> get the row of the cell where we found the match and add data to

          If Not aCell Is Nothing And aCell.Offset(0, 5).Value <> "" And aCell.Offset(0, 6).Value = "" Then
          MsgBox " " & PickerName2.Text & " is currently picking - " & aCell.Offset(0, 1) & " " & aCell.Offset(0, 2) _
          & " " & aCell.Offset(0, 3) _
          & " "
          UserForm1.Hide

          Else
          MsgBox " " & PickerName2.Text & " has no outstanding PIK!", vbExclamation
          PickerName2.Value = ""
          Exit Sub
           End If

    End With
    PickNo2.Value = ""
    PickerName2.Value = ""
    UserForm1.Hide

End Sub

I have done some searching online and tried something similar to the following code but keep getting a object required error but cannot see where I am going wrong?

Dim rng As Range
Dim i As Integer
Dim finalrow As Integer

finalrow = Sheets("PickData").Range("A10000").End(xlUp).Row

    For i = 2 To finalrow
    If Cells(i, 1).Value = UserForm1.PickerName2.Text And (Cell.Offset(i, 5) <> "") And (Cell.Offset(i, 6) = "") Then
      MsgBox " " & PickerName2.Text & " is currently picking - " & Cell.Offset(i, 1) & " " & Cell.Offset(i, 2) _
      & " " & Cell.Offset(i, 3) _
      & " "
      End If
    Next i

Upvotes: 0

Views: 66

Answers (1)

barryleajo
barryleajo

Reputation: 1952

Your first code attempt using the Range.Find method is a good start. Now extend this approach by using the Range.FindNext method.

This link should help you.

In your second block of code:

The references to Cell.Offset... should probably be something like Cells(i,1).Offset(0,5) and Cells(i,1).Offset(0,1) and Cells(i,1).Offset(0,3) respectively.

Also the second reference to PickerName2 should be qualified with UserForm1, as in UserForm1.PickerName2

Upvotes: 1

Related Questions