break inconsistent rows of data into a long list

[nozza858]

Hi, I've only posted once before, so sorry if this isn't very clear.

I've got a list of email addresses with additional information associated to them in random length rows as shown below (dummy email addresses used).

I want to be able to capture each email into it's own row, with the additional information alongside it in additional columns (an email's associated data always follows after each email).
I know I can identify each email address as it will always have an "@" in it, but the number of additional bits of information varies between each email address.

Can anyone advise how best to do this? I assume some sort of looping in VBA (i don't know VBA but would look to adapt something in existence perhaps?)

I've got about 270 rows, and some of the rows go over 300 columns across.

hope this makes sense.

thanks

Steve


EXAMPLE FROM MY EXCEL - I'm running Office 365

range of data formatted as below
column 1	column 2	column 3	column 4	column 5	column 6	column 7	column 8
email1@email	deliver	email2@email	pending	fail	email3@email	receive	deliver
email4@email	receive	pending	email5@email
email6@email	pending	email7@email	receive	email8@email	Receive	Pending	Fail
need to turn into a long list
column 1	column 2	column 3	column 4
email1@email	deliver
email2@email	pending	fail
email3@email	receive	deliver
email4@email	receive	pending
email5@email
email6@email	pending
email7@email	receive
email8@email	Receive	Pending	Fail

<tbody>
</tbody>

 

[MickG]

Assuming your actual data starts on row 2, then try this for results on sheet2, starting "A1".

[COLOR="Navy"]Sub[/COLOR] MG25Apr32
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Range("A1").CurrentRegion
ReDim nRay(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To UBound(Ray, 1) * UBound(Ray, 2))
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
   [COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] InStr(Ray(n, Ac), "@") > 0 [COLOR="Navy"]Then[/COLOR]
           c = c + 1: col = 0
        [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(n, Ac)) [COLOR="Navy"]Then[/COLOR]
            col = col + 1
            oMax = Application.Max(oMax, col)
            nRay(c, col) = Ray(n, Ac)
        [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] n

Sheets("Sheet2").Range("A1").Resize(c, oMax).Value = nRay
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

This may be helpful !!!
To Save and Run Code:-
Copy code from Thread
In Your Data sheet , Click "Alt+F11",:- Vb Window appears.
From the VBWindow toolbar, Click "Insert" ,"Module":- New VBwindow appears .
Paste Code into this window.
Close Vbwindow.

On sheet Click "Developer tab", Click "Macro". Macro dialog box appears.
Select Macro (with same name) from List.
On the right of Dialog box Click "Run"
The Sheet2 should now be updated.
Regards Mick