Search code examples
excelvbaautomation

How to find duplicates in multiple column in excel

By using vb script i want to do the following. So i just want to take the values from A and B column then print duplicate if its repetitive and not sold further if its not even sold once then print na. (Edited the question to be more accurate sorry for causing confusions) Thanks in advance
enter image description here

Solution

  • If I understand you correctly, maybe something like this ?

    Sub test()
Dim rg As Range: Dim rgS As Range: Dim cell As Range
Dim cnt As Long: Dim inf As String
Dim arr: Dim el

'make the range of data in column A into rg variable
Set rg = Range("A1", Range("A" & Rows.Count).End(xlUp))

'make a unique value in rg, put in arr variable
Set arr = CreateObject("scripting.dictionary")
For Each cell In rg: arr.Item(cell.Value) = 1: Next

'loop to each unique item in arr
For Each el In arr
    
    'check if the looped el has a "sold" value by using countifs
    'and put the result of the countifs into cnt variable
    cnt = Application.CountIfs(rg, el, rg.Offset(0, 1), "sold")
    
    'put a value into inf variable to be used as the expected result
    'it depends on the cnt value
    If cnt = 0 Then inf = "na" Else inf = "duplicate"
    
    'replace the rg value which has el value into TRUE
    'then get the range of rg which has TRUE into rgS variable
    'bring back the el value in rg by replacing the TRUE value into el
    With rg
        .Replace el, True, xlWhole, , False, , False, False
        Set rgS = .SpecialCells(xlConstants, xlLogical).Offset(0, 1)
        .Replace True, el, xlWhole, , False, , False, False
    End With
    
    'replace the rgS value which has "not sold" value into TRUE
    'put the inf value to the range of rgS which has TRUE offset 1
    'bring back the "not sold" value in rgS by replacing the TRUE value into "not sold"
    With rgS
        .Replace "not sold", True, xlWhole, , False, , False, False
        .SpecialCells(xlConstants, xlLogical).Offset(0, 1).Value = inf
        .Replace True, "not sold", xlWhole, , False, , False, False
    End With
    
Next

End Sub