combining rows of data to make complete records

[cjemerson8]

Hi-

Can someone assist me with this task (maybe Dave Peterson?)? I have seen
similar posts and solutions but cannot get the macro to produce the results
I need

I have 5000 rows of data , with 20 columns.

The rows I am trying to combine are (for example)

John Smith 123 Main Street Anytown AS 12345
John Smith 123 Main Street
(e-mail address removed)

I would like to combine the records ( when there is an exact match on the
name )to be

John Smith 123 Main Street Anytown AS 12345 (e-mail address removed)

Problem is, some records have the city, state and zip that I need, some have
the email address, some have the country information

Can someone suggest an easy way to do this - I have used Dave Peterson's
macro
Sub testme()

Dim wks As Worksheet
Dim iRow As Long
Dim iCol As Long

Dim FirstRow As Long
Dim LastRow As Long
Dim maxColsToCheck As Long

maxColsToCheck = 50

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value <> .Cells(iRow - 1, "A").Value Then
'do nothing
Else
For iCol = 2 To maxColsToCheck
If UCase(.Cells(iRow - 1, iCol).Value) = "0" Then
.Cells(iRow - 1, iCol).Value = .Cells(iRow,
iCol).Value
End If
Next iCol
'delete that duplicate
.Rows(iRow).Delete
End If
Next iRow
End With

End Sub

but the rows do not look as if they are all being combined with every field
of data.

Any suggestions would be GREATLY APPRECIATED!

 

[Dave Peterson]

How do you know where to put each field?

If you don't care where each field goes--just as long as it's all on one row:

Option Explicit
Sub testme01()

Dim wks As Worksheet
Dim iRow As Long
Dim iCol As Long
Dim DestCell As Range

Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("sheet1")

With wks
FirstRow = 2 'headers in row 1???
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow + 1 Step -1
If .Cells(iRow, "A").Value <> .Cells(iRow - 1, "A").Value Then
'do nothing
Else
Set DestCell _
= .Cells(iRow - 1, .Columns.Count).End(xlToLeft).Offset(0, 1)

.Range(.Cells(iRow, "B"), _
.Cells(iRow, .Columns.Count).End(xlToLeft)).Copy _
Destination:=DestCell

'delete that duplicate
.Rows(iRow).Delete
End If
Next iRow
End With

End Sub