need a macro to combine rows, columns

  • Thread starter Thread starter mrsjcd3
  • Start date Start date
M

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!
 
Without a macro..........

Data>Filter>Advanced Filter

Copy to another location.

Unique records only.


Gord Dibben MS Excel MVP
 
But that takes away the second or third rows that have different information
in the columns...
 
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?
 
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
 
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
 
Back
Top