Need to improve speed of concatenation macro

Hi,
I’ve got two columns, column A and B. I need to concatenate the data in column B, for which the data in column A is the same. Please see the spreadsheet for a visual explanation.
The macro shown below works, however, I have tens of thousands of rows of data, and would like to improve the speed at which this macro works.
I believe the way to do this is to create arrays, instead of row by row, but I don’t know how to do this.
Any help is much appreciated. Thank you.

Sub Combine_Programs()
Dim section As Long, concattxt As String, lastpos As Long


section = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
contattxt = ""
lastpos = 2

For i = 2 To section
concattxt = Sheets("Sheet1").Range("B" & i).Value

For j = i + 1 To section
If Sheets("Sheet1").Range("A" & i).Value = Sheets("Sheet1").Range("A" & j).Value Then
concattxt = concattxt & ", " & Sheets("Sheet1").Range("B" & j).Value
i = j
End If
Next

Sheets("sheet1").Range("I" & lastpos).Value = concattxt
lastpos = lastpos + 1
concattxt = ""
Sheets("sheet1").Cells(1, 4) = i
Next
End Sub

This is awesome Norie!! Thank you. One more question...is there an easy way to do the same thing, except transpose into separate columns, instead of concatenate into one?

Thanks.

That's perfect!!!!!!!!! Thank you so much for helping!!!! Much appreciated!

Mike, This program is even better...
Another question for you, I need to do the same process for some other data, except instead of transposing into separate cells, I need to concatenate it into a single cell, for each row. Is there a quick way to do that with your code?
Thanks.

Wow, you're fast! I'm getting an error with the line

.Offset(, 1).Value = .Item(e)

Not sure how to fix it.

WOW!!! Thank you so much!! I appreciate your help and time!!!