Macro/VBA code help for moving data from 1 line to another thendeleting redundant lines

[violetmunky]

Hi all,

I have an Excel spreadsheet of product details (around 1,500) that I
need to re-format via a macro. The problem I have is that each
product has several urls (up to 8 in total) that point to different
photographs of the product in question however each url is on a
different line within the spreadsheet and I need to put them in
sequential order on one line. Ideally, I would then want to delete
the lines on the spreadsheet where the url information has been moved
from.

This is a simple representation of how the spreadsheet looks at the
moment:


A B C D
1 Productid 1 url1
2 Productid 1 url2
3 Productid 1 url3
4 Productid 2 url1
5 productid 2 url2

Each line contains exactly the same product information except for the
column containing the URL (in the above example column B) which
changes.

I need to move all the urls that correspond to each product onto the
same line and in sequence. For example: for productid 1, url2 (b2)
needs to move to c1 and url3 (b3) needs to move to d1. Now that there
are no further urls that correspond to productid 1, the macro would
continue on and apply the procedure to productid 2 in which url2 (b5)
needs to move to c4. Note: a product may have up to 8 associated
urls.

Example:

A B C D
1 Productid 1 url1 *url2* *url3*
2 Productid 1 url2
3 Productid 1 url3
4 Productid 2 url1 *url2*
5 productid 2 url2

Once the url has been moved to the first line for each productid, this
additional line is no longer required and needs to be deleted. I
should therefore be left with the following data once the macro has
finished running (i.e. lines 2,3 and 5 in the above example):


A B C D
1 Productid 1 url1 url2 url3
2 Productid 2 url1 url2

Could anybody point me in the right direction in terms of achieving
this. The deletion of redundant lines is not a major problem (this
can be done manually by applying a filter afterwards) however would be
nice. The main sticking point is moving the urls to the first product
line.

Thank you in advance for your help!

 

[Joel]

The code below need to be modified. It look like the data in column A need
to be split into a production number and a url. I did not do this in the
code below becuase I couldn't tell how to split the data. Does the URL start
with http://? I supplied a second macro using HTTP to split the data.


Sub move_url()

RowCount = 1
Do While Range("A" & RowCount) <> ""
LastCol = Cells(RowCount, Columns.Count).End(xlToLeft).Column
NewCol = LastCol + 1
If Range("A" & RowCount) = Range("A" & (RowCount + 1)) Then
Range("A" & (RowCount + 1)).Copy _
Destination:=Cells(RowCount, NewCol)
NewCol = NewCol + 1
Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop
End Sub

here is code using HTTP: to split the data

Sub move_url2()

RowCount = 1
First = True
Do While Range("A" & RowCount) <> ""
If First = True Then
data = UCase(Range("A" & RowCount))
HTTP_POS = InStr(UCase(data), "HTTP:")
URL = Trim(Mid(data, HTTP_POS))
data = Trim(Left(data, HTTP_POS - 1))
Range("A" & RowCount) = data
Range("B" & RowCount) = URL
NewCol = 3 'column C
First = False
End If
If Range("A" & (RowCount + 1)) <> "" Then
next_data = UCase(Range("A" & (RowCount + 1)))
HTTP_POS = InStr(UCase(next_data), "HTTP:")
URL = Trim(Mid(next_data, HTTP_POS))
next_data = Trim(Left(next_data, HTTP_POS - 1))

If data = next_data Then
Cells(RowCount, NewCol) = URL
NewCol = NewCol + 1
Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
First = True
End If
Else
RowCount = RowCount + 1
End If
Loop
End Sub

 

[violetmunky]

Hi Joel,

Many thanks for your reply and apologies for the late reply - I've
just returned from holiday.

The first routine (without HTTP split) was exactly what I wanted and
works perfectly and my life has been made a whole lot easier!

Thanks once again for your help!