Vertical to Horizontal Data Content w/ DeDuped Special Conditions 2

I am using some data scraping software to get all the image urls from the site so I can use them in my other database. Here is the problem the data is coming in vertically and I need it horizontally "well use transpose" yes works but I also need to DeDup and there are about 53,000 images and do not want to go through it one line at a time. I would like to use a macro for this. Here is what I have and what I need the finished product to look like.


Column 1
SKU 1
SKU 1
SKU 1
SKU 1
SKU 1
Column 2
Image1
Image2
Image3
Image4
Image5
Column 1
SKU 2
SKU 2
SKU 2
SKU 2
SKU 2
SKU 2
SKU 2
Column 2
Image1
Image2
Image3
Image4
Image5
Image6
Image7
Column 1
SKU 3
SKU 3
Column 2
Image1
Image2


Needs to be like this:

SKU 1 | Image1 | Image2 | Image3 | Image4| Image5
SKU 2 | Image1 | Image2 | Image3 | Image4 | Image5 | Image6 | Image7
SKU 3 | Image1 | Image2


So the Sku will need to be DeDuped and all images for that sku transposed to that sku
The number of images change any where from 1 - 19 images per sku.

I hope I explained this well enough!
Any help would be much appreciated.

Thanks,
Guy

Guy,

See attachment. Let me know if you were looking for something different.

Hope this helps,
~tigeravatar

The images need to be transposed to the the same Sku row and the duplicate sku removed after

I have uploaded an example of how the data is coming in and how I need it to be formatted using a macro. http://www.pixeleightmedia.com/example.xls

Any help would be much appreciated
Thank you.

Guy,

Give this macro a try:

Sub SKUTranspose()

    Application.ScreenUpdating = False
    
    Dim ThisSKU As String:  ThisSKU = vbNullString
    Dim rngSKU As Range:    Set rngSKU = ActiveSheet.Range("A2:" & Cells(Rows.Count, 1).End(xlUp).Address)
    Application.CutCopyMode = False
    ActiveSheet.Range("A1:C1").Copy
    ActiveSheet.Range("D1:F1").PasteSpecial xlPasteAll
    ActiveSheet.Range("D1:F1").PasteSpecial xlPasteColumnWidths
    Application.CutCopyMode = False
    
    Dim aCell As Range, rngDest As Range
    For Each aCell In rngSKU
        If aCell.Value <> ThisSKU Then
            ThisSKU = aCell.Value
            Set rngDest = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Offset(1, 0)
            rngDest.Value = ThisSKU
            rngDest.Offset(0, 1).Value = aCell.Offset(0, 1).Value
            rngDest.Offset(0, 2).Value = aCell.Offset(0, 2).Value
        Else
            Set rngDest = ActiveSheet.Range("D" & Rows.Count).End(xlUp)
            ActiveSheet.Cells(rngDest.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = aCell.Offset(0, 1).Value
            ActiveSheet.Cells(rngDest.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = aCell.Offset(0, 2).Value
        End If
    Next aCell
    ActiveSheet.Range("A1:C1").EntireColumn.Delete xlShiftToLeft
    ActiveSheet.UsedRange.EntireColumn.ColumnWidth = 45
    ActiveSheet.Range("A1").EntireColumn.ColumnWidth = 10
    Application.ScreenUpdating = True
    
End Sub

Hope that helps,
~tigeravatar

Yes this works great except for one thing; and that is if one of the image fields are blank it fills it in with the next image url. Is there a way that if the image url is blank, could it be left blank after the the macro has run? Thank you very much for your time and support as I am very new to VBA.

thanks a lot for this wonderful solution