Concatenate and Delete

[Dee Sperling]

I've got a spreadsheet with most of the same information on contiguous lines.
I am trying to concatenate all values in 1 specific column and delete the
others after I've added the data to the first row.

For example:
Record Number Action Type Operator Last Name Operator First Name Operator
Mid Init NUMBER
4450 New SMITH JAMES L 12345
4450 New SMITH JAMES L 673425
4450 New SMITH JAMES L 98444D
4450 New SMITH JAMES L 98K7AAA
4706 New JONES TOM 34345Y33
4706 New JONES TOM 98763R
4738 New JONES TOM 13222
4844 New BERBAUM CECELIA 787JU8
4844 New BERBAUM CECELIA 44UY33
4844 New BERBAUM CECELIA POL987
4844 New BERBAUM CECELIA 339999
4844 New BERBAUM CECELIA 999333

I know the code below isn't written correctly, so I'm hoping someone can
tell me how to write it.
'set first row
Set CurrentRow to 2
'Only run the Do until Column B is empty
For Count=1 to (as many rows as have data in column B)
'If the fields in the current row are the same as the one below, then add the
'value from column I in the 2nd row to the value in column I of the current
row.
'Then delete the 2nd row and start over.
Do while (("B" & CurrentRow) & ("D" & CurrentRow) & ("E" & CurrentRow) & "F"
& CurrentRow)) =(("B" & CurrentRow+1) & ("D" & CurrentRow+1) & ("E" &
CurrentRow+1) & "F" & CurrentRow+1))
Set ("I" & CurrentRow) + ("I" & CurrentRow) & " " & ("I" & CurrentRow+1)
Delete CurrentRow+1
Loop
'set the current row to the next row.
CurrentRow = CurrentRow+1
Next

Thank you for your time,
Dee

 

[Joel]

Sub DeleteDups

RowCount = 2
Do while Range("B" & (RowCount + 1)) <> ""
'Only run the Do until Column B is empty
if Range("B" & RowCount) = Range("B" & (RowCount + 1)) then
For ColCount = 1 to 9
if cells(RowCount,ColCount) <> cells(RowCount + 1,ColCount) then
cells(RowCount,ColCount) = cells(RowCount,ColCount) & _
vbCRLF & cells(RowCount + 1,ColCount)
rows(RowCount + 1).delete
end if
Next Colcount
else
RowCount = RowCount + 1
end if
Loop

end sub

 

[Dee Sperling]

Thank you Joel. I wasn't clear enough.
What I want to do is leave the first row with a specific recnum, lastname,
firstname, middleinit, concatenate all the numbers into the same cell in the
first row that has the same specific recnum, lastname, firstname, middleinit,
then delete the row.
Then go onto the next row (which at this point should have a different
specific recnum, lastname, firstname, middleinit from the previous one and do
the same.

 

[Joel]

What is wrong? Your code was comparing columns B (Record Number). I think
the Record number may be in column A. I also think you only wnat to combine
column F. The Record Number is unique so you don't havve to compare names
only the record number.

This is what I think you need?

Sub DeleteDups()

RowCount = 2
Do While Range("A" & (RowCount + 1)) <> ""
'Only run the Do until Column A is empty
If Range("A" & RowCount) = Range("A" & (RowCount + 1)) Then
Range("F" & RowCount) = Range("F" & RowCount) & _
vbCrLf & Range("F" & (RowCount + 1))
Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop

End Sub

 

[Dee Sperling]

My employer requires that I compare the following fields, as they may vary
within a record number:
RecNum (Col C), LastName (Col D), FirstName (Col E), MidInit (Col F), then
concatenate all the values in Number (Col I on my sheet) into Number (col I),
then delete all the duplicate rows with cols C, D, E, and F that match the
first row.

I though I could **concatenate col I in the first row with col I in the 2nd
row, delete that 2nd row, and repeat from ** until at least one of the values
in RecNum (Col C), LastName (Col D), FirstName (Col E), MidInit (Col F)
changed.

Sometimes the RecNum will be the same, but the people's names are different.
I need to consolidate all the numbers for a (RecNum (Col C), LastName (Col
D), FirstName (Col E), MidInit (Col F)) set in the first instance's col I and
delete all the rest
Dee

 

[Joel]

Try this


Sub DeleteDups()

RowCount = 2
'Only run the Do until Column B is empty
Do While Range("C" & (RowCount + 1)) <> ""
OldRecNum = Range("C" & RowCount)
OldLastName = Range("D" & RowCount)
OldFirstName = Range("E" & RowCount)
OldMidInit = Range("F" & RowCount)

NewRecNum = Range("C" & (RowCount + 1))
NewLastName = Range("D" & (RowCount + 1))
NewFirstName = Range("E" & (RowCount + 1))
NewMidInit = Range("F" & (RowCount + 1))

If (OldRecNum = NewRecNum) And _
(OldLastName = NewLastName) And _
(OldFirstName = NewFirstName) And _
(OldMidInit = NewMidInit) Then

Range("I" & RowCount) = Range("I" & RowCount) & _
vbCrLf & Range("I" & (RowCount + 1))
Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop

End Sub

 

[Dee Sperling]

Brilliant! Thank you so much!
I had to change vbCrLf to " " but other than that, it worked a charm!

Dee