need a macro to combine rows, columns

[mrsjcd3]

How do I go from this:
id name email zone 1 zone 2 zone 3
123 john (e-mail address removed) dog
123 john (e-mail address removed) cat
456 mary (e-mail address removed) cat
789 sue (e-mail address removed) dog
789 sue (e-mail address removed) cat
789 sue (e-mail address removed) rabbit

To this:
id name email zone 1 zone 2 zone 3
123 john (e-mail address removed) dog cat
456 mary (e-mail address removed) cat
789 sue (e-mail address removed) dog cat rabbit

Thanks!

 

[Gord Dibben]

Without a macro..........

Data>Filter>Advanced Filter

Copy to another location.

Unique records only.


Gord Dibben MS Excel MVP

 

[mrsjcd3]

But that takes away the second or third rows that have different information
in the columns...

 

[Patrick Molloy]

the advanced filter only hides those rows since they don't match the criteria.
By copying only the visible rows to a new sheet, your requirement is answered.
Seems your question may need to be re-phrased perhaps?

 

[mrsjcd3]

What I need to do it to combine the different columnal information for the
same person which is currently in multiple rows, in to one row for that
person. I am not filtering, I am combining. I was hoping not to have to
cut, paste and delete 6000+ rows of data to condense it down to 3500 rows.
In my example, id # 123 has two rows, but each row has different columnal
information. I need to have all that data in one row. If I filter, I lose
the second or third row of information which I wanted to combine in to the
first row.
id name email zone 1 zone 2 zone 3
123 john (e-mail address removed) dog
123 john (e-mail address removed) cat
456 mary (e-mail address removed) cat
789 sue (e-mail address removed) dog
789 sue (e-mail address removed) cat
789 sue (e-mail address removed) rabbit

 

[Patrick Molloy]

Sub Main()
Dim col As Long
Dim thisrow As Long
Range("A1").CurrentRegion.Sort Range("A1")

For thisrow = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(thisrow, 1) = Cells(thisrow - 1, 1) Then
For col = 4 To Cells(thisrow, Columns.Count).End(xlToLeft).Column
Cells(thisrow - 1, Columns.Count).End(xlToLeft).Offset(, 1) = _

Cells(thisrow, col)
Next
Rows(thisrow).Delete
End If
Next



End Sub