Merge Duplicate Rows unique values into single rows for an infinite amount of columns/rows

I have data with duplicate Part Numbers in an infinite amount of rows in column A, unique data in column B and duplicate data again in an infinite amount of columns (spreadsheet columns can vary so would like the range to be infinite).
I need to merge all the duplicate Part Numbers into a single row and merge the column B values into a single cell delimited by a comma and then merge all the duplicate values for the rest of the columns.

I found this macro that partially works. It identifies duplicate rows in A and merges the data in B and from columns D onwards but it deletes column C.

Option Explicit

Sub MergeGeneIDs()
'Jerry Beaucaire, 2/6/2012
'Merge rows matching on column A, opt to eliminate duplicates
Dim LR As Long, Rw As Long, Delim As String

If MsgBox("Eliminate duplicate values as they are merged?", _
vbYesNo, "Duplicates") = vbYes Then [C1] = True

Delim = Application.InputBox("What is the delimiter?", "Delimiter", ",", Type:=2)
If Delim = "False" Then Exit Sub
If Delim = "" Then Delim = ","

Application.ScreenUpdating = False
LR = Range("A" & Rows.Count).End(xlUp).Row

Range("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

With Range("C2:C" & LR)
.Formula = "=IF(A2=A3,IF($C$1,IF(ISNUMBER(SEARCH(B2,C3)), C3, C3 & """ & _
Delim & """ & B2), C3 & """ & Delim & """ & B2), B2)"
.Value = .Value
.Copy Range("B2")
.Formula = "=A2=A1"
End With

Range("C:C").AutoFilter
Range("C:C").AutoFilter 1, True
Range("C2:C" & LR).EntireRow.Delete xlShiftUpMacro test.xls
Range("C:C").AutoFilter
Range("C:C").ClearContents
Columns.AutoFit

Application.ScreenUpdating = True
End Sub


how can i fix this? thanks

not sure why my spreadsheet didnt attach the first time...Macro test.xls