Copy and paste cells if Duplicate columns , Excel Macro slightly different question

Question

Hi I have another macro I wanted to create which is very similar to the one that has been given here. This time I don't want to specify a exact word because I won't know what word they will give, instead I would just like it to de dupe and copy whatever it finds in that column to the one respondent. How would I edit this? Thanks

Serial,Q1,Q2,Q4

1,yes,sometimes

1,,,Often

2,,,yes

3

2,,maybe

AFTER: Serial,Q1,Q2,Q4

1,yes,sometimes,Often

2,,maybe,yes

3,,,,

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim strWhere As String
Dim i As Integer


strFile = ActiveWorkbook.FullName


strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"



Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")


cn.Open strCon
strSQL = "SELECT a.[Name], " _
       & "(SELECT Max([Black]) FROM [Sheet3$] b WHERE b.[Name]=a.Name ) As Black, " _
       & "(SELECT Max([Blue]) FROM [Sheet3$] b WHERE b.[Name]=a.Name ) As Blue, " _
       & "(SELECT Max([Green]) FROM [Sheet3$] b WHERE b.[Name]=a.Name ) As Green " _
       & "FROM [Sheet3$] a " _
       & "GROUP BY a.[Name]"



rs.Open strSQL, cn, 3, 3

For i = 0 To rs.fields.Count - 1
    Sheets("Sheet5").Cells(1, i + 1) = rs.fields(i).Name
Next

Worksheets("Sheet5").Cells(2, 1).CopyFromRecordset rs