How to flag duplicates in excel column

[pete_me_a]

Hello guys,

Please help, i would like to flag duplicates in one column. I would like a final result as follows:
ID Product Value Duplicate check
1 chips 20
2 salt -20 duplicate
2 salt 20 duplicate
3 sugar 20
4 stones 40 duplicate
4 stones 40 duplicate

I have written code and so far I am only able to flag the the second line which is a duplacte. I have a function which is doing the following:

Function flag_duplicates(value1 as integer,value2 as integer,id1 as string,id2 as string,product1 as string,product2 as string) as string
Total_Value = Value1 + value2
IF Total_VALUE = 0 THEN
IF ID1 = ID2 and product1 = product2 THEN
flag_duplicates = "DUPLICATE"
else
flag_duplicates = "--"

End function


How can I enhance this to ge the result tha i want as shown above.

please help

[User_5]

Hi pete_me_a,

I put together this code very quickly and I'm pretty sure this is what you're looking for.
Its a stand-alone Sub instead of a function as I wasn't sure how you're calling the function.
You can change it to a function and insert the parameters if its really necassary.
Also, it checks for duplicates based only on the Value and Product since if they're
duplicated, there's no need to check the ID, as they all have unique numbers. So
there's really no need to check for the ID. But if you want that feature, post back and we can add it.
Also notice it has two loops to accomplish the task, which seems like a waste, but we're pasting
values in two cells based on the offset property and we don't want to overwrite any cells.
So the second loop checks for empty cells only after the first task is complete.
There are several other ways to write this code but this works fine unless you have a huge database
and speed is critical.

Code: Select all

 Sub Flag_Duplicates()
  Dim i As Long
  Dim RwCount As Long
  Dim cell As Range
  Dim Value1 As String
  Dim Value2 As String
  RwCount = Cells(Cells.Rows.Count, "C").End(xlUp).Row
  For i = RwCount To 2 Step -1
      Set cell = Cells(i, "C")
      Value1 = cell.Offset(0, -1) & cell
      Value2 = cell.Offset(-1, -1) & cell.Offset(-1, 0)
      If Value1 = Value2 Then
          cell.Offset(0, 1) = "duplicate"
          cell.Offset(-1, 1) = "duplicate"
          If cell.Value = "Duplicate check" Then Exit Sub
      End If
  Next i
  For i = RwCount To 2 Step -1
    Set cell = Cells(i, "D")
    If cell.Value = vbNullString Then cell.Value = "--"
  Next i
End Sub


If you change the column header "Duplicate check" to something else, then change this line:

Code: Select all

           If cell.Value = "Duplicate check" Then Exit Sub 


to the new column header.

[pete_me_a]

hello user_5,

Thank you very much for your reply, very much appreciated indeed. Kindly review the code below, it works and returns whar I want but i have a problem where there are more tha three rows for the same customer. My objective is to identify refunds or exchanges for a given customer. I have a file with thousandas rows. I am passing parameters as seen beloew, the problem is that I am only passing a maximum of three customer ID's. therefore if a customer has more than three the return value is incorrect. Some customers have up to 16 and there is no way of telling the maximum number of customer ID'. Please help. I can explain further if need be.

Public Function Get_refunds_exchange(DHW_TRANSACTION_TWO As String, DHW_TRANSACTION_ONE As String, DHW_TRANSACTION_THREE As String, _
PRODUCT_ID_TWO As String, PRODUCT_ID_ONE As String, PRODUCT_ID_THREE As String, _
SALES_VALUE_TWO As Integer, SALES_VALUE_ONE As Integer, SALES_VALUE_THREE As Integer, _
SALES_UNIT_TWO As Integer, SALES_UNIT_ONE As Integer, SALES_UNIT_THREE As Integer) As String

Dim Total_value_one As Integer
Dim Total_value_two As Integer

Total_value_one = (SALES_VALUE_TWO + SALES_VALUE_ONE)
Total_value_two = (SALES_VALUE_TWO + SALES_VALUE_THREE)

'identify refunds for a gicen customer ...Check for refunds only..
'Logic:If its the same customer, check if its the same product and total sales value is 0, then its a refund
If (((DHW_TRANSACTION_TWO = DHW_TRANSACTION_ONE) _
And (Total_value_one = 0) _
And (PRODUCT_ID_TWO = PRODUCT_ID_ONE)) _
Or _
((DHW_TRANSACTION_TWO = DHW_TRANSACTION_THREE) _
And (Total_value_two = 0) _
And (PRODUCT_ID_TWO = PRODUCT_ID_THREE))) Then

Get_refunds_exchange = "Refund"

'Identify exchanges for a given customer ...Check for an exchange
ElseIf (((DHW_TRANSACTION_TWO = DHW_TRANSACTION_ONE) _
And (Total_value_one = 0) _
And ((SALES_UNIT_TWO < 0) Or (SALES_UNIT_ONE < 0)) _
And ((PRODUCT_ID_TWO <> PRODUCT_ID_ONE))) _
Or _
((DHW_TRANSACTION_TWO = DHW_TRANSACTION_THREE) _
And (Total_value_two = 0) _
And ((SALES_UNIT_TWO < 0) Or (SALES_UNIT_THREE < 0)) _
And ((PRODUCT_ID_TWO <> PRODUCT_ID_THREE)))) Then

Get_refunds_exchange = "Exchange"

ElseIf (((DHW_TRANSACTION_TWO = DHW_TRANSACTION_ONE) _
And (Total_value_one <> 0) _
And ((SALES_UNIT_TWO < 0) Or (SALES_UNIT_ONE < 0))) _
Or _
((DHW_TRANSACTION_TWO = DHW_TRANSACTION_THREE) _
And (Total_value_two <> 0) _
And ((SALES_UNIT_TWO < 0) Or (SALES_UNIT_THREE < 0)))) Then

Get_refunds_exchange = "Exchange with payment"

Else
Get_refunds_exchange = "---"
End If

End Function

[pete_me_a]

Hello User_5,

Thank you for the sub routine, it does what i would like but i have a lot more conditions to check, please check the code i have pasted, in the mean time i will try to see if i can modify this

[User_5]

Hi pete_me_a,

Try setting up a loop that runs the code for each name in the customer list.
Its very difficult for me to work with your code because I don't know where you're getting your information from for
the function parameters. I would need to build a whole worksheet in order to call the function.

I resorted to using an InputBox to get the name and product ID because I don't know how you get input from the user.
I would need to see the procedure that calls the function. You can change these lines to match your method for getting
user input.

Your goal is to get your function to look this:

'Get the value of each cell in the range that contains the names
For Each cell in range to number of rows in range

------ Code goes here ------

Next cell

Try something like the following. Again, I can't work with your function as I can't call it. I don't know
what the parameters mean. An example would be DHW_TRANSACTION_ONE. I assume this is the customer ID but not sure.

This code checks for three parameters as you can see. Its meant to perform this logic only as a starting
point but set up as a loop.

Code: Select all

     If (((DHW_TRANSACTION_TWO = DHW_TRANSACTION_ONE) _
           And (Total_value_one = 0) _
           And (PRODUCT_ID_TWO = PRODUCT_ID_ONE)) _


Try pasting this:

Code: Select all

     
Sub Check_for_refund()
    Dim lCell As Range
    Dim Total_value As Integer
    Dim Cust_Name As String
    Dim PRODUCT_ID As String
    Dim Get_refunds_exchange As String
    Dim i As Long
     
    'Get user input
    Cust_Name = UCase(Application.InputBox("Enter name :", , , , , , 2))
    PRODUCT_ID = UCase(Application.InputBox("Enter product ID :", , , , , , 2))
   
    'You must change the range in next the line to match the range that contains
    'the customer names. But you can use it with the example worksheet to test it.
   
     For Each lCell In Range("E2:E10")
        Total_value = UCase(lCell.Offset(0, -1))
        'Check if its the same customer and Total_value = 0 and PRODUCT_ID is the same
        If UCase(lCell.Value) = Cust_Name _
            And Total_value = 0 _
            And UCase(lCell.Offset(0, -2)) = PRODUCT_ID Then
            Get_refunds_exchange = "Refund"
        Else: Get_refunds_exchange = "No Refund!"
            'Exit Sub
        End If
          MsgBox Get_refunds_exchange
    Next lCell
 
End Sub


Run the following code in a new workbook to test the code above:

Code: Select all


Sub BuildExampleSheet()
  With ActiveSheet
      Cells(1, 3) = "PRODUCT_ID"
      Cells(1, 4) = "Total_value"
      Cells(1, 5) = "Cust_Name"
      Range("C2, C5, C8") = "Toys"
      Range("C3, C6") = "Crafts"
      Range("C4, C7, C9") = "Hardware"
      Range("C10") = "Auto"
      Range("D2, D3") = 0
      Range("D4, D5") = 5.99
      Range("D6:D10") = 0
      Range("E2, E3") = "Mary"
      Range("E4, E6, E10") = "Helen"
      Range("E5, E7") = "Jim"
      Range("E8, E9") = "Joe"
  End With
End Sub


Then try enterig different in the cells to see if the logic is correct. If its not, please reply with what went wrong.
We can expand on this after the logic is correct.

[pete_me_a]

hi User_5,

Thank you for your help indeed. I enhanced your original code, it took me while to understand it but now i do so i am using the subroutine and not the function. The enhance code is below. My problem is that if a customer has more than three lines ie, 5 some rows are not being flagged. If a condition is met and the return value its say "part exchange", I would like to flag all rows for that customer with the same value. If I check for onley one condition its ok but in this case I have three conditions and its not working. Can you please help. The output is as below but two rows have not been flagged.

customer ID product code sales unit Sales value routine output
0004355000206056415 26 1 849.99 ---
0004355000206056415 32 1 119.00 ---
0004355000206056415 40 2 159.90 Part exchange
0004355000206056415 41 1 -278.90 Part exchange
0004355000206056415 42 -1 -499.00 Part exchange


Sub Flag_Duplicates()
Dim i As Long
Dim RwCount As Long
Dim Customer_ID As Range
Dim product_id As Range
Dim sales_unit_ID As Range
Dim sales_value_ID
Dim Value1 As String 'Customer ID value
Dim Value2 As String 'Customer ID value
Dim product_value1 As String 'Product code
Dim product_value2 As String 'product code
Dim Result As Range 'Output string - actual result
Dim Sales_Value1 As Integer 'sales value
Dim Sales_Value2 As Integer 'Sales value
Dim Sales_Unit1 As Integer 'Sales Unit value
Dim Sales_Unit2 As Integer 'Sales unit Value
Dim Total_Sales As Integer

'Count Cells using the Customer ID
RwCount = Cells(Cells.Rows.Count, "B").End(xlUp).Row

For i = RwCount To 2 Step -1

'Set columns to be evaluated
Set Customer_ID = Cells(i, "B")
Set product_id = Cells(i, "C")
Set sales_unit_ID = Cells(i, "D")
Set sales_value_ID = Cells(i, "E")
Set Result = Cells(i, "F")

'Capture data from the define columns
Value1 = Customer_ID.Offset(0, 0)
Value2 = Customer_ID.Offset(-1, 0)
product_value1 = product_id
product_value2 = product_id.Offset(-1, 0)
Sales_Unit1 = sales_unit_ID
Sales_Unit2 = sales_unit_ID.Offset(-1, 0)
Sales_Value1 = sales_value_ID
Sales_Value2 = sales_value_ID.Offset(-1, 0)

'Evaluate capture data
Total_Sales = (Sales_Value1 + Sales_Value2)
If ((Value1 = Value2) And (Total_Sales = 0) And (product_value1 = product_value2)) Then
Result.Offset(0, 0) = "Refund"
Result.Offset(-1, 0) = "Refund"
ElseIf ((Value1 = Value2) And (Total_Sales > 0) And (product_value1 = product_value2) And (Sales_Value1 > 0 And Sales_Value2 < 0)) Then
Result.Offset(0, 0) = "Discount/Special offer"
Result.Offset(-1, 0) = "Discount/Special offer"
ElseIf ((Value1 = Value2) And (Total_Sales = 0) And (product_value1 <> product_value2)) Then
Result.Offset(0, 0) = "Full Exchange"
Result.Offset(-1, 0) = "Full Exchange"
ElseIf ((Value1 = Value2) And (Total_Sales <> 0) And (product_value1 <> product_value2) And (Sales_Value1 < 0 Or Sales_Value2 < 0)) Then
Result.Offset(0, 0) = "Part exchange"
Result.Offset(-1, 0) = "Part exchange"
Else
' Result.Offset(0, 1) = "---"
Result.Offset(-1, 0) = "---"
If Customer_ID.Value = "Duplicate Check" Then Exit Sub
End If
Next i
For i = RwCount To 2 Step -1
Set Result = Cells(i, "F")
If Customer_ID.Value = vbNullString Then Result.Value = "well check"
Next i
End Sub

[pete_me_a]

Hello guys,

Can anyone help with the code above. I am having problems perfroming checks on a dynamic range i.e the range of duplicate customr ID's . The above works bt of where a user has two rows, if a user has more tha n two it is not working. Your help will be appreciated.

Pete

[Sisyphus]

Hello pete_me_a,
Your problem isn't one of VBA code any more. By now it is one of presentation and motivation.
1. Presentation
The solution being discussed at the bottom of your thread bears no resemblance to the question you originally asked. You write some code, User_5 writes some which you amend and integrate, then you post the mixture without even observing the forum rule to enclose it in Code brackets which would make it easier for some one to read and copy. You also don't post any part of the environment in which your code is supposed to run - that would be a worksheet with some real data in it - and every time User_5 comes up with a solution you point to some new criteria you hadn't mentioned before.
2. Motivation
Everybody here knows that 20 minutes of programming may easily take 2 hours of testing. On a big project it may take more time to set up the test than to write the code. So, you go and write the code, then come to the forum for the testing. That isn't a fair distribution of glory - not to mention the fact that you make sure no proper testing is possible becasue you withhold both, environment and facts. The people here want to help you for the fun of it. Their "fun" is to understand a problem and solve it; like doing a crossword or sudoku puzzle. Are you offering them a chance to enjoy themselves?

As for me, I don't enjoy trying to read your code. If I were to solve the problem I would probably take an approach that is different from the one you have settled on. I can't do that because I can't find your problem between all the many pages of code you have posted, all of it indistinguishable from text and at variance with code suggested by User_5. If you wanted my help to solve some problem in the code you would post those two lines that your own tests have determined that they cause the problem. I am sure, other members on this forum feel the same. Why not make it easy on them and me to help you?

This current thread is between you and User_5. No one else can understand what you two have been discussing. If you want to continue it, make it easy on User_5 to extend his patience.

Where problems persist, make new posts to find specific solutions, avoiding your errors of method of the past. If you want a new approach, post your problem completely and supported by a sample workbook. On the other hand, if you want help with your own code, do your own testing until such point that you have identified the problem. Then post that problem. If you get your question right you will find no shortage of answers on this forum.

[pete_me_a]

Hi Sisyphus


Thank you for your comments, i will try observe forum rules next time.

user 5 indeed helped me and resolved the bulk of the problem, the subsquent question was only to enhance and make my solution robust.

I will open a new thread for my subsquent question.

Thank you

pete