Identifying unique data based on 2 criteria using the .find function

metalfish

New Member
Joined
May 10, 2017
Messages
2
Hi all,
I am working on a macro that will take data from one workbook and move it into another scheduling workbook. When i transfer the data over to the scheduling workbook I need to check to make sure the data i am transferring is unique based upon two criteria, Job# and heat#. If the new data is unique then it will add a new line if it is not unique it will add the Qty to the existing line. It is possible that I will have the same job# with different heat numbers so i need to be able to look at each of occurrence of the job# in the database and then compare the heat# to determine my unique values. I am able to identify duplicate values based on the job # using the find function, but i am not able to make it look at the heat# to complete the second half of my data validation. Any help would be greatly appreciated.

thanks in advance.


Code:
Function IsDuplicate() As Boolean
    Dim resultcheck As Boolean
    Dim x As Range
    Dim Schedule As Workbook
    Set Schedule = Workbooks("Schedule.xlsm")
    
    Dim Sched As Worksheet
    Set Sched = Schedule.Sheets("Sched")
    
    Dim db As Worksheet
    Set db = Schedule.Sheets("DB")
    
    db.Activate
    With ActiveSheet.Columns(1)
    Set x = .Find(What:=Me.Job, _
                            After:=Cells(2, 1), _
                            LookIn:=xlValues, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
     
     If x Is Nothing Then
        resultcheck = False
     Else
        Set Z = x
        x.Select
       If Cells(ActiveCell.Row, 27).Value = Me.tbHeat.Value Then
            resultcheck = True
           
       Else
           Do
               Set x = .Find(What:=Me.Job, _
                   After:=x, _
                   LookIn:=xlValues, _
                  Lookat:=xlWhole, _
                   SearchOrder:=xlByRows, _
                   SearchDirection:=xlNext, _
                   MatchCase:=False)


               If Not x Is Nothing Then
               x.Select
                   If x.Address = Z.Address Then
                   Exit Do
                   
               Else
                   x.Select
                   If Cells(ActiveCell.Row, 27).Value = Me.tbHeat.Value Then
                       resultcheck = True
                   Else
                       Exit Do
                    End If
                    End If
                    End If
                Loop
            End If
     End If
     
     End With
IsDuplicate = resultcheck
  
End Function
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

metalfish

New Member
Joined
May 10, 2017
Messages
2
I figured it out. Here is the code that works just FYI

Code:
Function IsDuplicate() As Boolean
    Dim resultcheck As Boolean
    Dim x As Range
    Dim Schedule As Workbook
    Set Schedule = Workbooks("Schedule.xlsm")
    
    Dim Sched As Worksheet
    Set Sched = Schedule.Sheets("Sched")
    
    Dim db As Worksheet
    Set db = Schedule.Sheets("DB")
    
    db.Activate
    With ActiveSheet.Columns(1)
    Set x = .Find(What:=Me.Job, _
                            After:=Cells(2, 1), _
                            LookIn:=xlValues, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
     
     If x Is Nothing Then
        resultcheck = False
     ElseIf db.Cells(x.Row, 27) = CInt(Me.tbHeat) Then
            resultcheck = True
            Else
                Set Z = x
                Do
                    Set x = .FindNext(After:=x)
                    If db.Cells(x.Row, 27) = CInt(Me.tbHeat) Then
                        resultcheck = True
                    ElseIf x.Address = Z.Address Then
                        resultcheck = False
                        Exit Do
                    End If
                Loop
     End If
     End With
IsDuplicate = resultcheck
  
End Function
 

Watch MrExcel Video

Forum statistics

Threads
1,090,041
Messages
5,412,012
Members
403,408
Latest member
Matt_314

This Week's Hot Topics

Top