Simple VBA loop

[MPFraser7]

I have a list of names, departments and phone numbers in row A. Entries are separated with a cell with 0. Here’s an example of the layout of the data.

John Smith

ABC

999-999-9999

0

Jane Smith

ABC

888-888-8888

777-777-7777

0

Alex Smith

ABC

<tbody>
</tbody>

Some entries have more than one phone number. What I want to do with this data, is to turn it into this:

John Smith	ABC	999-999-9999
Jane Smith	ABC	888-888-8888	777-777-7777
Alex Smith	ABC

<tbody>
</tbody>

I assume the code will look for the first 0 in row A, select a range of cells until it hits the next 0, move the range in the first blank row starting in column A, then loop to find the next 0. Any ideas?

 

[Scott T]

Try

This start putting data into A7 as noted below you can change the row by changing r=

 Sub splitdata()
Dim lc As Long
Dim rng As Range
lc = Cells(1, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(1, 1), Cells(1, lc))
r = 7 [COLOR=#008000]'starting row of where data to be put change to row where you want the data to start
[/COLOR]col = 1
For Each cell In rng
    If cell <> 0 Then
        Cells(r, col) = cell
        col = col + 1
    Else
        col = 1
        r = r + 1
    End If
Next cell
End Sub

 

[MPFraser7]

Works like a charm, thanks!