Different entries for each product picture

Question

I have a list of products with the ID and the picture name. One entry per picture, instead of one entry per product and the pictures in columns as I need it. If the file had only a few entries, the manual procedure I guess it would be to cut all the picture names for the same product, paste (transpose) and remove the entries without names. But since the file has over 100,000 entries, does anyone know how to do this using VBA?

EXAMPLE: What I have...

product_id;  picture_name
1;           picture1.jpg
1;           picture2.jpg
1;           picture3.jpg
2;           picture4.jpg
3;           picture5.jpg
3;           picture6.jpg

What I need...

product_id;   1st_picture;   2nd_picture;   3rd_picture...
1;            picture1.jpg;  picture2.jpg;  picture3.jpg
2;            picture4.jpg
3;            picture5.jpg;  picture6.jpg

Thank so you much in advance for your help.

Answer 1

I guess this solves your problem

• Compare two consecutive rows one by one
• If two rows matches,Take the corresponding value in 2nd column of 2nd row put the value in next to 2nd column of 1st row and delete the 2nd row
• If not matches skip the previous step and go for comparison of next two rows.

Here is the Code

Sub SortPics()
i = 2
Do
Flag = False
VarComp1 = Sheets("YourSheetName").Cells(i, 1).Value
VarComp2 = Sheets("YourSheetName").Cells(i + 1, 1).Value
If VarComp1 = VarComp2 And VarComp2 <> "" Then
    Set VarSec1 = Sheets("YourSheetName").Cells(i, 2)
    Set VarSec2 = Sheets("YourSheetName").Cells(i + 1, 2)
    VarSec1.Offset(0, 1 + j).Value = VarSec2.Value
    Sheets("YourSheetName").Cells(i + 1, 1).EntireRow.Delete
    i = i - 1
    Flag = True
End If
i = i + 1
If Flag = True Then
    j = j + 1
Else
    j = 0
End If 

Loop While VarComp1 <> ""

End Sub