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

[TABLE="width: 796"]
<tbody>[TR]
[TD="colspan: 3"]range of data formatted as below[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]column 1[/TD]
[TD]column 2[/TD]
[TD]column 3[/TD]
[TD]column 4[/TD]
[TD]column 5[/TD]
[TD]column 6[/TD]
[TD]column 7[/TD]
[TD]column 8[/TD]
[/TR]
[TR]
[TD]email1@email[/TD]
[TD]deliver[/TD]
[TD]email2@email[/TD]
[TD]pending[/TD]
[TD]fail[/TD]
[TD]email3@email[/TD]
[TD]receive[/TD]
[TD]deliver[/TD]
[/TR]
[TR]
[TD]email4@email[/TD]
[TD]receive[/TD]
[TD]pending[/TD]
[TD]email5@email[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email6@email[/TD]
[TD]pending[/TD]
[TD]email7@email[/TD]
[TD]receive[/TD]
[TD]email8@email[/TD]
[TD]Receive[/TD]
[TD] Pending[/TD]
[TD] Fail[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]need to turn into a long list[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]column 1[/TD]
[TD]column 2[/TD]
[TD]column 3[/TD]
[TD]column 4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email1@email[/TD]
[TD]deliver[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email2@email[/TD]
[TD]pending[/TD]
[TD]fail[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email3@email[/TD]
[TD]receive[/TD]
[TD]deliver[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email4@email[/TD]
[TD]receive[/TD]
[TD]pending[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email5@email[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email6@email[/TD]
[TD]pending[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email7@email[/TD]
[TD]receive[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]email8@email[/TD]
[TD]Receive[/TD]
[TD] Pending[/TD]
[TD] Fail[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[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