I have a list of codes in A and the image links in B and C.
What i want to do is remove the duplicates and arrange the unique links in a single column and give them a series name with incrementing no code_1 before image link 1 and code_2 before link 2 as shown in the picture.
Sub tgr() Dim wb As Workbook Dim wsDest As Worksheet Dim rData As Range Dim rArea As Range Dim aData As Variant Dim i As Long, j As Long Dim hUnq As Object 'Prompt to select range. Uniques will be extracted from the range selected. 'Can select a non-contiguous range by holding CTRL On Error Resume Next Set rData = Application.InputBox("Select range of names where unique names will be extracted:", "Data Selection", Selection.Address, Type:=8) On Error GoTo 0 If rData Is Nothing Then Exit Sub 'Pressed cancel Set hUnq = CreateObject("Scripting.Dictionary") For Each rArea In rData.Areas If rArea.Cells.Count = 1 Then ReDim aData(1 To 1, 1 To 1) aData(1, 1) = rArea.Value Else aData = rArea.Value End If For i = 1 To UBound(aData, 1) For j = 1 To UBound(aData, 2) If Not hUnq.Exists(aData(i, j)) And Len(Trim(aData(i, j))) > 0 Then hUnq(Trim(aData(i, j))) = Trim(aData(i, j)) Next j Next i Next rArea Set wb = rData.Parent.Parent 'First parent is the range's worksheet, second parent is the worksheet's workbook Set wsDest = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)) wsDest.Range("A1").Resize(hUnq.Count).Value = Application.Transpose(hUnq.Items) End Sub