I have this code that check duplicate and copy the data to another sheet.
I’m wondering if VBA could also write if it’s duplicate number 1, 2, and so on based on which duplicate row is the first one. If it is possible I wish to write Duplicate 1, Duplicate 2, and so on in Column BK.
'Cek Duplikat pindahin ke sheet tempcek (cek melihat ke email)
Dim objDic As Object, rngData As Range
Dim i As Long, sKey As String, dupRng As Range, rowRng As Range
Dim arrData, oSht1 As Worksheet, oSht2 As Worksheet
Const KEY_COL = "T" ' Col [Email]
Const COL_CNT = 20 ' Col A to T
Set objDic = CreateObject("scripting.dictionary")
Set oSht1 = Sheets("ALL")
Set oSht2 = Sheets("tempcek")
' load data from sheet1
With oSht1
Set rngData = .Cells(1, KEY_COL).Resize(.Range(KEY_COL & .Rows.Count).End(xlUp).Row)
End With
arrData = rngData.Value
If Not VBA.IsArray(arrData) Then
MsgBox "No data is on Sheet1.", vbCritical
Exit Sub
End If
' load data into Dict
For i = LBound(arrData) + 1 To UBound(arrData)
arrData(i, 1) = CStr(arrData(i, 1))
sKey = arrData(i, 1)
Set rowRng = oSht1.Cells(i, 1)
If objDic.Exists(sKey) Then
If dupRng Is Nothing Then
Set dupRng = Application.Union(rowRng, objDic(sKey))
Else
Set dupRng = Application.Union(dupRng, rowRng, objDic(sKey))
End If
Else
Set objDic(sKey) = rowRng
End If
Next i
If Not dupRng Is Nothing Then
Debug.Print dupRng.Address
dupRng.EntireRow.Copy oSht2.Range("A2")
End If