By the way I forgot to mention that the output will be in Sheet3, just in case you didnt pick that one up from the macro.

You could first generate a unique list of part numbers and then iterate through this unique parts list to identify kcodes form the full list and concatenate these together. Have copied some code below. Should work in kcode1.xlsx but havent fully tested. Create a button (Button1_Click defined below) and call the two functions in that sequence. Hope that helps

Sub Button1_Click()

Call generateUniquePartNo
Call populateKCodes

End Sub

Function generateUniquePartNo() 'generate unique part number list first

'variable declarations
Dim inputRange As Range
Dim inputCell As Object
Dim inputLast As String
Dim inputPart As String
Dim outputRange As Range
Dim outputCell As Object
Dim outputLast As String
Dim outputPart As String
Dim matchTracker As Long

'clear previous run
Worksheets("Sheet3").Range("A2:B300000").Clear

'define input range
inputLast = Worksheets("Sheet1").Range("A300000").End(xlUp).Address(False, False)
Set inputRange = Worksheets("Sheet1").Range("A2:" & inputLast)

'loop through raw data range
For Each inputCell In inputRange

matchTracker = 0 'reset tracker

inputPart = inputCell.Value 'get current row part number

'define output range dynamically as it grows
outputLast = Worksheets("Sheet3").Range("A300000").End(xlUp).Address(False, False)
Set outputRange = Worksheets("Sheet3").Range("A2:" & outputLast)

'loop through data range
For Each outputCell In outputRange

outputPart = outputCell.Value 'get output part number
If outputPart = inputPart Then matchTracker = matchTracker + 1 'if we have a match then increment tracker

Next outputCell

'if no matches to output list then it is unique
If matchTracker = 0 Then
Worksheets("Sheet3").Range("A300000").End(xlUp).Offset(1, 0).Value = inputPart 'output part number
End If

Next inputCell

End Function

Function populateKCodes()

'variable declarations
Dim theRange As Range
Dim theCell As Object
Dim lastCell As String
Dim thePart As String
Dim rawListPart As String
Dim rawListKCode As String
Dim rawRange As Range
Dim rawCell As Object
Dim rawLast As String

'define range parameters
rawLast = Worksheets("Sheet1").Range("A300000").End(xlUp).Address(False, False)
lastCell = Worksheets("Sheet3").Range("A300000").End(xlUp).Address(False, False)
Set theRange = Worksheets("Sheet3").Range("A2:" & lastCell)
Set rawRange = Worksheets("Sheet1").Range("A2:" & rawLast)

'loop through unique parts list range
For Each theCell In theRange

thePart = theCell.Value 'get part number in unique list

'loop through the raw data arange
For Each rawCell In rawRange

rawListPart = rawCell.Value 'get part number

'if the part number match then we need to get the kcode for that row
If rawListPart = thePart Then
rawListKCode = rawCell.Offset(0, 1).Value 'get kcode

'generate output
If theCell.Offset(0, 1).Value = "" Then 'if nothing added so far then this is the first entry for the part num
theCell.Offset(0, 1).Value = rawListKCode 'just add kcode
Else
theCell.Offset(0, 1).Value = theCell.Offset(0, 1).Value & ", " & rawListKCode 'concatenate kcode to existing kcodes
End If

End If

Next rawCell

Next theCell

End Function