Add a column next to current cell

[align=left][COLOR=#333333][FONT=monospace][SIZE=12px]Sub mergeCategoryValues()
Dim lngRow As Long


'This is using activesheet, so make sure your worksheet is
' selected before running this code.
Sheets("Consolidated").Activate
With ActiveSheet


    'We are looking for duplicate Job Numbers
    '  which is column 1. Set that here if it needs
    '  to change.
    Dim columnToMatch As Integer: columnToMatch = 2


    'Figure out the last row
    lngRow = .Cells(65536, columnToMatch).End(xlUp).Row


    'Sort the records by the column we will use to match . Column B holds the Employee ID
    .Cells(columnToMatch).CurrentRegion.Sort key1:=.Cells(columnToMatch), Header:=xlYes


    'Loop through each row starting with last and working our way up.
    Do


        'Does this row match with the next row up according to the Employee ID in Column B            
If .Cells(lngRow, columnToMatch) = .Cells(lngRow - 1, columnToMatch) Then


            'Loop through columns B though P
            For i = 1 To 16 '1000 max (?)


                'Determine if the next row up already has a value. If it does leave it be
                '   if it doesn't then use the value from this row to populate the next
                '   next one up.


                If .Cells(lngRow - 1, i).Value <> "" Then
                    If .Cells(lngRow - 1, i).Value <> .Cells(lngRow, i).Value Then
                    .Cells(lngRow - 1, i).Value = .Cells(lngRow - 1, i).Value & "; " & .Cells(lngRow, i).Value
                   End If
                End If
            Next i


            'Now that we've processed all of the columns, delete this row
            '   as the next row up will have all the values
            .Rows(lngRow).Delete
        End If


        'Go to the next row up and do it all again.
        lngRow = lngRow - 1
    Loop Until lngRow = 1
End With
End Sub[/SIZE][/FONT][/COLOR][/align]