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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
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
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top