Create new row subject to data in a field

[josco]

Hi everyone, I am new here as a member and hope you will be able to help.

I am trying to upload some data in a CSV to an online system which requires that each record is on a different line, but the data I have been given is all on one line, let me try to explain.

This is the data I have:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Prod ID[/TD]
[TD]Prod Desc[/TD]
[TD]ImgSrc1[/TD]
[TD]ImgSrc2[/TD]
[TD]ImgSrc3[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD]Useful Product[/TD]
[TD]12.jpg[/TD]
[TD]13.jpg[/TD]
[TD]14.jpg[/TD]
[/TR]
[TR]
[TD]5678[/TD]
[TD]Less Useful Item[/TD]
[TD]15.jpg[/TD]
[TD]16.jpg[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

And this is how I wish it to look:
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Prod ID[/TD]
[TD]Prod Desc[/TD]
[TD]ImgSrc[/TD]
[TD]ImgNumber[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD][/TD]
[TD]12.jpg[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD][/TD]
[TD]13.jpg[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]1234[/TD]
[TD][/TD]
[TD]14.jpg[/TD]
[TD]3[/TD]
[/TR]
[TR]
[TD]5678[/TD]
[TD][/TD]
[TD]15.jpg[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]5678[/TD]
[TD][/TD]
[TD]16.jpg[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]

Couple of points, I don't need all the other fields, just the Prod ID, ImgSrc and an incrementing number for each image associated with a Prod ID. Also some of the images may be used more than once, they are not unique.

I hope someone can help, I have been wrestling with this for a little while and as there are over 500 records, more later, I don't want to do this manually.

Best regards

Jonathan

 

[wideboydixon]

Put this in a new module and run it when positioned on your data sheet:

Public Sub josco001()

Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim thisRow As Long
Dim lastRow As Long
Dim thisCol As Long
Dim lastCol As Long
Dim nextRow As Long

' Set up the sheets
Set sourceSheet = ActiveSheet
Set targetSheet = Worksheets.Add(After:=sourceSheet)

' Set up the header row
targetSheet.Cells(1, 1).Value = "Prod ID"
targetSheet.Cells(1, 2).Value = "ImgSrc"
targetSheet.Cells(1, 3).Value = "ImgNumber"

' Find the last row of data
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row

' Next row to populate on the target sheet
nextRow = 2

' Process all rows
For thisRow = 2 To lastRow
    ' Make sure there's at least one image file
    If sourceSheet.Cells(thisRow, 3).Value <> "" Then
        ' Find the last column that contains an image file
        lastCol = sourceSheet.Cells(thisRow, sourceSheet.Columns.Count).End(xlToLeft).Column
        
        ' Process all image file columns
        For thisCol = 3 To lastCol
            ' Set the Prod ID, Image Source and Image Number
            targetSheet.Cells(nextRow, 1).Value = sourceSheet.Cells(thisRow, 1).Value
            targetSheet.Cells(nextRow, 2).Value = sourceSheet.Cells(thisRow, thisCol).Value
            targetSheet.Cells(nextRow, 3).Value = thisCol - 2
            
            ' Move to the next row
            nextRow = nextRow + 1
        Next thisCol
    End If
Next thisRow

End Sub

WBD

 

[josco]

WBD

Wow, I copied the code and placed it in a new module with the data I have been given expecting to have a bit of head scratching and probably coming back here to ask further help, but no, it just worked!

Thank you very much.

 

[wideboydixon]

Cool! That's always good when it works first time

WBD