Increment a row based on another column with duplicates possible
Sub uniqueIndex()
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = ActiveSheet
Set ws2 = wb.Sheets.Add
ws1.Range("J:J").AdvancedFilter ACtion:=xlFilterCopy,
CopyToRange:=ws2.Range("A1"), unique:=True
ws2.Range("B1").Value = "1"
ws2.Range("B1").AutoFill ws2.Range("B1",
ws2.Range("A65536").End(xlUp).Offset(0, 1)), xlFillSeries
ws1.Range("A1").Formula = "=vlookup(J1,'" & ws2.Name & "'!A:B,
2,false)"
ws1.Range("A1", ws1.Range("J65536").End(xlUp).Offset(0,
-9)).FillDown
ws1.Range("A:A").Copy
ws1.Range("A1").PasteSpecial xlPasteValues
Application.DisplayAlerts = False
ws2.Delete
Application.DisplayAlerts = True
Set ws2 = Nothing
Set ws1 = Nothing
Set wb = Nothing
End Sub
|