In column B, there are some duplicate ID #s that I need to merge the multiple rows into one in order to get a vlookup formula to work.

Most ID #s appear on only one row, some ID #s have 2 rows, some appear on 3 rows and an ID appears on 5 rows.

I have a formula in column A that identifies duplicate ID #s that is

=IF(AND(B20=B19,A19=""),1,IF(AND(B20=B19,A19=1),2,IF(AND(B20=B19,A19=2),3,IF(AND(B20=B19,A19=3),4,IF(AND(B20=B19,A19=4),5,"")))))

I'm trying to loop thru the 6,000 rows to determine if a 1 is located, and if the next cell below blank, if so, then copy a formula (concatenates & totals data for the 2 rows above) from row 3 and insert it below the row with the 1. If a 1 is located but there is a 2 below and it is blank below the 2, then copy a formula from row 4 insert it below the row with the 2.

I've tried several formulas.

The latest version is shown below.

When I run it, it get a compile error: Next without For.

I'd like to solve this because as the year progresses, the number of transactions increases, and I don't want to have to manually copy and insert the formulas - it is time-consuming.

I'd appreciate some insight from one of you masters out there.

Thanks.

Sub Macro2()

'

' Macro2 Macro

' Macro recorded 08/03/2007 by

'

'

LastRow = ActiveSheet.UsedRange.Rows.Count

Application.ScreenUpdating = False

'Set the range to evaluate to rng.

Set rng = Range("a10:a6000")

'initialize i to 1

I = 1

'Loop for a count of 1 to the number of rows

'in the range that you want to evaluate.

For counter = 1 To rng.Rows.Count

If rng.Cells(I) = 1 And rng.Cells(I + 1) = "" Then

Rows("3:3").Select

Selection.Copy

ActiveWindow.LargeScroll Down:=7

Rows(I + 1).Select

Selection.Insert Shift:=xlDown

End If

If rng.Cells(I) = 1 And rng.Cells(I + 1) = 2 And rng.Cells(I + 2) = "" Then

Rows("4:4").Select

Selection.Copy

ActiveWindow.LargeScroll Down:=7

Rows(I + 2).Select

Selection.Insert Shift:=xlDown

End If

If rng.Cells(I) = 1 And rng.Cells(I + 1) = 2 And rng.Cells(I + 2) = 3 And rng.Cells(I + 3) = "" Then

Rows("5:5").Select

Selection.Copy

ActiveWindow.LargeScroll Down:=7

Rows(I + 3).Select

Selection.Insert Shift:=xlDown

End If

If rng.Cells(I) = 1 And rng.Cells(I + 1) = 2 And rng.Cells(I + 2) = 3 And rng.Cells(I + 4) = 5 And rng.Cells(I + 5) = "" Then

Rows("8:8").Select

Selection.Copy

ActiveWindow.LargeScroll Down:=7

Rows(I + 3).Select

Selection.Insert Shift:=xlDown

Else: I = I + 1

Next

End If

End Sub