Copy and paste cells if Duplicate columns , Excel Macro

Question

Hi, I am not very techi-but I have been recording and editing basic Excel Macros for a little while. I have found a few results which almost match my issue, however I am struggling to adapt it so I am hoping someone might be kind enough to help me?!

my issue:

Sheet 1

a/b/c/d

name/black/blue/green

Sam/1//1

Jill//1/

Jill/1//

Sam//1//

Sam/1/1/1

I have a name data base with duplicates in it. I need to de-dupe these, copy just one name (column a) onto a new page, and in the process I don't want to lose some of the data (column b-d) which might be in a duplicate name but not in the one going to be copied over.

Outcome I am hoping for:

Sheet 2

a/b/c/d

name/black/blue/green

Sam/1/1/1

Jill/1/1/

I have quite a few columns to search for data my example is b-d however it is actually AP-EC so it would be helpful if it is obvious which figures I might need to change...?

Thanks in advance.

Kez

Answer 1

You could try ADO, for example:

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

''http://support.microsoft.com/kb/246335

''This saves the name of the active workbook, as this is an example, it is best 
''to save before running the code.
strFile = ActiveWorkbook.FullName

''This is a standard connection string for Excel and ADO, it depends on strFile
''being the name of the current workbook, it should be, because that is 
''what the first line does
''Note also HDR=Yes, this means that the code expects the first row to be headers,
''in this case, Name, Black, Blue, Green
''You can get more on connection strings from: http://www.connectionstrings.com/
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"


''This creates the objects needed in the code
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

''This opens the connection 
cn.Open strCon

''This is fairly ordinary SQL, if you are having problems, try a simpler statement
''such as 
''SELECT * FROM [Sheet3$]
''It is important that you choose a sheet that exists in the activeworkbook
''and that the sheet has data.
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]"


''This uses the connection (cn) to open a recordset with the SQL (strSQL) 
''3, 3 refers to the cursor and lock type.
''More here: http://www.w3schools.com/ADO/met_rs_open.asp
rs.Open strSQL, cn, 3, 3

''All this does is put headers in sheet of your choice, I chose sheet5.
For i = 0 To rs.fields.Count - 1
    Sheets("Sheet5").Cells(1, i + 1) = rs.fields(i).Name
Next

''This copies the recordset into the sheet of your choice, 
''Sheet5 again, in this case
Worksheets("Sheet5").Cells(2, 1).CopyFromRecordset rs