Moving data and deleting duplicate row

[jcollinsjr]

Hello All,

I hope someone can help me. I've been searching for a week looking for a formula or macro that will do the following....

I want to delete the duplicate Test Program in column A, and move the corresponding System number(s) next to the first unique record in columns B through F. Essentially, combining records...

Any ideas on how I can accomplish this?

Thanks in advance,
John

 

[cgcamal]

Hi jcollinsjr,

Try with the following code:

Sub Moving_and_Delete_Duplicate_Data()
[COLOR=Green]'César C., 27/Aug/2011
'http://www.mrexcel.com/forum/showthread.php?t=574858[/COLOR]
Dim WF As WorksheetFunction, Lr As Integer, i As Integer, Count as Integer

Set WF = WorksheetFunction
Lr = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To Lr
    Count = WorksheetFunction.CountIf(Columns("A"), Cells(i, "A"))
    If Count > 1 Then
        Cells(i, "C").Resize(, Count - 1) = WF.Transpose(Range("B" & i + 1 & ":B" & i + Count - 1))
        Range("A" & i + 1 & ":B" & i + Count - 1).Delete Shift:=xlUp
        Cells(1, "B").Copy Destination:=Cells(1, "C").Resize(, Count - 1)
    ElseIf IsEmpty(Cells(i, "A")) Then
        Exit For
    End If
Next
End Sub

Hope this helps.

Regards.

 

[jcollinsjr]

The macro works great! It does everything I wanted. Thanks so much for the quick response!



John

 

[cgcamal]

The macro works great! It does everything I wanted. Thanks so much for the quick response!



John

Nice to know it works as you wanted John.

Best regards.