Heres the part of mu sub which contains the code and the looping part ive put in bold.

Many Thanks

Private Sub WorkDownColumn()

'These variables use currency because it has 4 decimal places

'Makes sure that macro begins with correct sheet

ActiveWorkbook.Sheets("original").Activate

' Select starting cell

Range("B2").Select

' Then locate next cell down

' After cell is selected, repeat function until end of column

' Macro ends when the next empty cell is reached

Do Until ActiveCell = ""

' Use the Excel worksheet function =match to locate the

' row of our product name

' and then compare the last two cells of this row

' with columns in the data sheet

Range("prdname").formula = ActiveCell

Range("rownum").FormulaR1C1 = "=match(prdname,products,0)"

If Cells(ActiveCell.Row, 33) = "" Then

If IsNumeric(Range("rownum")) Then

With Selection

.**End(xlToRight).Offset(0, 1) = _**

Sheets("data").Cells(Range("rownum"), 2)

.End(xlToRight).NumberFormat = "0"

'Once next quarter of data added this

'becomes end of row, so offset by one cell

.End(xlToRight).Offset(0, 1) = _

Sheets("data").Cells(Range("rownum"), 3)

.End(xlToRight).NumberFormat = "0"

.End(xlToRight).Offset(0, 1) = _

Sheets("data").Cells(Range("rownum"), 4)

.End(xlToRight).NumberFormat = "0"

.End(xlToRight).Offset(0, 1) = _

Sheets("data").Cells(Range("rownum"), 5)

.End(xlToRight).NumberFormat = "0"

.End(xlToRight).Offset(0, 1) = _

Sheets("data").Cells(Range("rownum"), 6)

.End(xlToRight).NumberFormat = "0"

.End(xlToRight).Offset(0, 1) = _

Sheets("data").Cells(Range("rownum"), 7)

.End(xlToRight).NumberFormat = "0"

End With

Else

Cells(ActiveCell.Row, 36).formula = _

"Unmatched name"

End If

Else: ActiveCell.Offset(1, 0).Select

'offsets the activecell if column 33 is not blank i.e.

'the product already contains a full 30 quarters of data

End If

ActiveCell.Offset(1, 0).Select

Loop

Range("a1").Select

DeleteNotepad

End Sub