Copy & Paste Duplicates

[stockgoblin42]

Hi, I have a list of lines with slopes and Y-intercepts. I'd like to identify all the parralell lines (equal slopes) and copy a few bits of info from those rows to another part of the page. See the highlighted areas in the attached file.

I take it I'll need a macro but how do I filter for duplicates first? Would I used the advanced Filter? What would the Criteria for the Criteria Range be?

Any ideas?

[wenqq3]

Sub CopyPaste_Duplicates()
Dim temp1, temp2 As String
Dim aRow, bRow, cRow, checkRep, i As Integer
Dim arrayC(100) As Integer


Range("A2").Select
aRow = ActiveCell.Row
cRow = 2
checkRep = 0
i = 1
Do
Do
ActiveCell.Offset(1, 0).Select
bRow = ActiveCell.Row
For j = 1 To 100
If aRow = arrayC(j) Then
Exit Do
End If
Next j

temp1 = Round(Range("A" & aRow & "").Value, 2)
temp2 = Round(Range("A" & bRow & "").Value, 2)
If temp1 = temp2 Then
If checkRep = 0 Then
Range("A" & aRow & ":D" & aRow & "").Copy
Range("P" & cRow & "").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
cRow = cRow + 1
checkRep = checkRep + 1
End If
arrayC(i) = bRow
Range("A" & bRow & ":D" & bRow & "").Copy
Range("P" & cRow & "").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
i = i + 1
cRow = cRow + 1
Range("A" & bRow & "").Select
End If
Loop Until IsEmpty(ActiveCell.Offset(1, 0)) = True

checkRep = 0
Range("A" & aRow & "").Offset(1, 0).Select
aRow = ActiveCell.Row
Loop Until IsEmpty(ActiveCell.Offset(1, 0)) = True

Range("Q:Q").Delete

End Sub

Try this.