VBA Check for duplicate value and change if duplicate.

CharlieDP

New Member
Joined
May 13, 2024
Messages
4
Office Version
  1. 365
Dear all, I am a new user of Excel VBA and try to use it to automize the daily working routine. Now I'm facing the problem of checking duplication and change the value.

So basically what I would like to do is to check the order for customers and I would like to check whether there are duplicate by checking customers' name appeared in the list of order records. If there are duplication I would like to check whether they require different items. If yes I will assign -n, which n equals to the number of times the order has duplicated, at the end of the order number to identify same customers with different orders.

Here is the code that I would like to use for achieving my needs,

Dim Sht As Worksheet
Set Sht = Worksheets
Set Dict = CreateObject("Scripting.Dictionary")

For x = 2 To LastRow

Do While Len(Sht.Cells(x, "B")) > 0
If Dict.Exists(CStr(Sht.Cells(x, "B"))) = False Then
Dict.Add CStr(Sht.Cells(x, "B")), x
Else
Cells(x, "B").Value = Cells(x, "B").Value & "-B"
Cells(x - 1, "B").Value = Cells(x - 1, "B").Value & "-A"
End If

x = x + 1
Loop
Next x

The problems that the code did not fulfill my requirement is that the duplicated data does not always stay together so I cannot simply just use x - 1 to achieve the order number modification. It is incapable to change the order number if there are more than 2 orders required from the same customers. I' not using customers requirement as a filter to check whether it is "Duplicated customers name different customers requirement" scenario as well.


The sample of the table has been attached in terms of mini-sheet for your reference. Thank you very much if you can response to this question and it's ok if you cannot. Just study with me together for advance VBA skills. I wish you all the best.
asking.xlsx
ABCD
1Order DateOrder NumberCustomersCustomers Requirement
213/5/2024AABBBBCCCMarkPen
313/5/2024AACCCCDDDJackCup
413/5/2024AADDDDEEEFrankRuler
513/5/2024AABBBBCCCMarkRuler
工作表1
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
See if this does what you are after:

VBA Code:
Sub AddOrderItemNo()

    Dim Sht As Worksheet
    Dim rngData As Range, arrData As Variant
    Dim rowLast As Long, Order1st As Long, nextNo As Long
    Dim dictData As Object, dictKey As String
    Dim i As Long
    
    Set Sht = ActiveSheet
    With Sht
        rowLast = .Range("B" & Rows.Count).End(xlUp).Row
        Set rngData = .Range(.Cells(2, "A"), .Cells(rowLast, "D"))
        arrData = rngData.Value2
    End With
    
    Set dictData = CreateObject("Scripting.Dictionary")
    
    ' Load details range into Dictionary
    For i = 1 To UBound(arrData)
        dictKey = arrData(i, 2)
        If Not dictData.exists(dictKey) Then
            dictData(dictKey) = -i
        ElseIf dictData(dictKey) < 0 Then
            nextNo = 1
            Order1st = -dictData(dictKey)
            arrData(Order1st, 2) = arrData(Order1st, 2) & "-" & nextNo
            nextNo = 2
            dictData(dictKey) = nextNo
            arrData(i, 2) = arrData(i, 2) & "-" & nextNo
        Else
            nextNo = dictData(dictKey) + 1
            dictData(dictKey) = nextNo
            arrData(i, 2) = arrData(i, 2) & "-" & nextNo
        End If
    Next i
    
    rngData.Columns(2).Value = Application.Index(arrData, 0, 2)
    rngData.Columns(2).AutoFit

End Sub
 
Upvote 1
See if this does what you are after:

VBA Code:
Sub AddOrderItemNo()

    Dim Sht As Worksheet
    Dim rngData As Range, arrData As Variant
    Dim rowLast As Long, Order1st As Long, nextNo As Long
    Dim dictData As Object, dictKey As String
    Dim i As Long
   
    Set Sht = ActiveSheet
    With Sht
        rowLast = .Range("B" & Rows.Count).End(xlUp).Row
        Set rngData = .Range(.Cells(2, "A"), .Cells(rowLast, "D"))
        arrData = rngData.Value2
    End With
   
    Set dictData = CreateObject("Scripting.Dictionary")
   
    ' Load details range into Dictionary
    For i = 1 To UBound(arrData)
        dictKey = arrData(i, 2)
        If Not dictData.exists(dictKey) Then
            dictData(dictKey) = -i
        ElseIf dictData(dictKey) < 0 Then
            nextNo = 1
            Order1st = -dictData(dictKey)
            arrData(Order1st, 2) = arrData(Order1st, 2) & "-" & nextNo
            nextNo = 2
            dictData(dictKey) = nextNo
            arrData(i, 2) = arrData(i, 2) & "-" & nextNo
        Else
            nextNo = dictData(dictKey) + 1
            dictData(dictKey) = nextNo
            arrData(i, 2) = arrData(i, 2) & "-" & nextNo
        End If
    Next i
   
    rngData.Columns(2).Value = Application.Index(arrData, 0, 2)
    rngData.Columns(2).AutoFit

End Sub
Appreciate for your help but I have a question. If I would like to assign letters rather than numbers in the end of order no how can I do so?
 
Upvote 0
This is only good for up to Z

VBA Code:
Sub AddOrderItemNo_Letter()

    Dim Sht As Worksheet
    Dim rngData As Range, arrData As Variant
    Dim rowLast As Long, Order1st As Long, nextNo As Long, nextLetter As String
    Dim dictData As Object, dictKey As String
    Dim i As Long
    
    Set Sht = ActiveSheet
    With Sht
        rowLast = .Range("B" & Rows.Count).End(xlUp).Row
        Set rngData = .Range(.Cells(2, "A"), .Cells(rowLast, "D"))
        arrData = rngData.Value2
    End With
    
    Set dictData = CreateObject("Scripting.Dictionary")
    
    ' Load details range into Dictionary
    For i = 1 To UBound(arrData)
        dictKey = arrData(i, 2)
        If Not dictData.exists(dictKey) Then
            dictData(dictKey) = -i
        ElseIf dictData(dictKey) < 0 Then
            nextNo = 1
            nextLetter = Chr(nextNo + 64)
            Order1st = -dictData(dictKey)
            arrData(Order1st, 2) = arrData(Order1st, 2) & "-" & nextLetter
            nextNo = 2
            nextLetter = Chr(nextNo + 64)
            dictData(dictKey) = nextNo
            arrData(i, 2) = arrData(i, 2) & "-" & nextLetter
        Else
            nextNo = dictData(dictKey) + 1
            dictData(dictKey) = nextNo
            nextLetter = Chr(nextNo + 64)
            arrData(i, 2) = arrData(i, 2) & "-" & nextLetter
        End If
    Next i
    
    rngData.Columns(2).Value = Application.Index(arrData, 0, 2)
    rngData.Columns(2).AutoFit

End Sub
 
Upvote 1
Solution
This is only good for up to Z

VBA Code:
Sub AddOrderItemNo_Letter()

    Dim Sht As Worksheet
    Dim rngData As Range, arrData As Variant
    Dim rowLast As Long, Order1st As Long, nextNo As Long, nextLetter As String
    Dim dictData As Object, dictKey As String
    Dim i As Long
   
    Set Sht = ActiveSheet
    With Sht
        rowLast = .Range("B" & Rows.Count).End(xlUp).Row
        Set rngData = .Range(.Cells(2, "A"), .Cells(rowLast, "D"))
        arrData = rngData.Value2
    End With
   
    Set dictData = CreateObject("Scripting.Dictionary")
   
    ' Load details range into Dictionary
    For i = 1 To UBound(arrData)
        dictKey = arrData(i, 2)
        If Not dictData.exists(dictKey) Then
            dictData(dictKey) = -i
        ElseIf dictData(dictKey) < 0 Then
            nextNo = 1
            nextLetter = Chr(nextNo + 64)
            Order1st = -dictData(dictKey)
            arrData(Order1st, 2) = arrData(Order1st, 2) & "-" & nextLetter
            nextNo = 2
            nextLetter = Chr(nextNo + 64)
            dictData(dictKey) = nextNo
            arrData(i, 2) = arrData(i, 2) & "-" & nextLetter
        Else
            nextNo = dictData(dictKey) + 1
            dictData(dictKey) = nextNo
            nextLetter = Chr(nextNo + 64)
            arrData(i, 2) = arrData(i, 2) & "-" & nextLetter
        End If
    Next i
   
    rngData.Columns(2).Value = Application.Index(arrData, 0, 2)
    rngData.Columns(2).AutoFit

End Sub
Alex Blakenburg

Appreciate for you help. A-Z is way more than enough for my case. Wish you all the best!
 
Upvote 0

Forum statistics

Threads
1,224,814
Messages
6,181,125
Members
453,021
Latest member
Justyna P

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