summarizing first and last entry with unqual number of entries

Good Evening

My experience with Excel (Excel 2007) is rather limited and I don't know any Excel experts in real life to ask for help, so I am hoping to find advise here...

My problem: I am working with an excel table holding names of persons in column A and biographic events (e.g. "birth", "relocation", "death") in column B. The number of events differs from person to person. The table comprises many persons, all are separated by an empty row. The table looks like this:

column A	column B
name1	event1
	event2
	event3
empty	empty
name2	event1
	event2
empty	empty
name3	event1
	event2
	event3
	event4
empty	empty
name4	event1
empty	empty
name5	...

I would like to be able to summarize data from this table omitting all but the first and (if available) the last, most recent event per person. In the summarized data, both should be stored next to each other and next to the person's name. This would greatly facilitate my further data exploration. So, my ideal summary table would look like this:

column A	column B	column C
name1	event1	event3
name2	event1	event2
name3	event1	event4
name4	event1
name5	...

I imagine that using a kind of loop would allow to assess when a next row will be an empty row and then to recognize the current event as the most recent event of that person. Unfortunately I don't have the knowledge and experience to translate that into a formula or VBA script. Especially the different number of entries for different persons is causing me problems.

I thank you for taking time and am looking forward to any suggestions,
N

Hi

This assumes that your example data is in the range A2:B14

Sub aaa()
  lastentry = ""
  For i = Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1
    If Len(Cells(i, 1)) + Len(Cells(i, 2)) = 0 Then 'the blank row
      Cells(i, 1).EntireRow.Delete shift:=xlUp
    ElseIf Len(Cells(i, "A")) = 0 And lastentry = "" Then 'the last entry in a block
      lastentry = Cells(i, "B")
      Cells(i, 1).EntireRow.Delete shift:=xlUp
    ElseIf Len(Cells(i, 1)) > 0 Then 'the first entry in a block
      Cells(i, Columns.Count).End(xlToLeft).Offset(0, 1).Value = lastentry
      lastentry = ""
    Else
      Cells(i, 1).EntireRow.Delete shift:=xlUp
    End If
  Next i
End Sub

rylo

Thank you very much, rylo!
Working perfectly and exactly what I was hoping for.

N