Help Change existing Code
 

I have code that first looks at house number, if same then look at street
name, if same, look at suite number, if same, look at ID#, if different,
display the results - see below. I have source data that looks like:

A B C D E F G
H I
ParentID BLD StuLast StuFirst Street# Strname Suite# City
Zip
286 AHS Andrus Mat 6847 HIGH TROY 48098
286 WLS Andrus Lauren 6847 HIGH TROY 48098
736 MUE Andrus Chris 6847 HIGH TROY 48098
736 AEL Andrus Emma 6847 HIGH TROY 48098

Currently, My code results in only lauren and chris's record being displayed
in the results page, but I need both records to be displayed when the parent
ID in column a matches.

Any assistance would be greatly appreciated.


Sub GetDuplicates()

With Sheets("PasteDataHere")
'First Sort Data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set SortRange = .Rows("1:" & LastRow)
SortRange.Sort _
key1:=.Range("E1"), _
order1:=xlAscending, _
key2:=.Range("F1"), _
order2:=xlAscending, _
key3:=.Range("A1"), _
order3:=xlAscending, _
header:=xlYes

NewRow = 1
RowCount = 2
Start = RowCount
Duplicate = False
Do While .Range("A" & RowCount) < ""
If .Range("E" & RowCount) = _
.Range("E" & (RowCount + 1)) And _
Left(.Range("F" & RowCount), 3) = _
Left(.Range("F" & (RowCount + 1)), 3) And _
.Range("G" & RowCount) = _
.Range("G" & (RowCount + 1)) And _
.Range("A" & RowCount) < _
.Range("A" & (RowCount + 1)) Then


Duplicate = True
Else
If Duplicate = True Then
Duplicate = False
..Rows(Start & ":" & RowCount).Copy _
Destination:=Sheets("Results").Rows(NewRow)
NewRow = NewRow + (RowCount - Start) + 1
Else
Start = RowCount + 1
End If
End If
RowCount = RowCount + 1
Loop

If Duplicate = True Then
Duplicate = False
..Rows(Start & ":" & RowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRow + 1)
End If
End With

End Sub

Help Change existing Code
 

This look l;ike my code from a previous posting. Try these changes. I
didn't test them out but it looks like it will solve the problem.

Sub GetDuplicates()

With Sheets("PasteDataHere")
'First Sort Data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set SortRange = .Rows("1:" & LastRow)
SortRange.Sort _
key1:=.Range("E1"), _
order1:=xlAscending, _
key2:=.Range("F1"), _
order2:=xlAscending, _
key3:=.Range("A1"), _
order3:=xlAscending, _
header:=xlYes

NewRow = 1
RowCount = 2
Start = RowCount
Duplicate = False
Do While .Range("A" & RowCount) < ""
If .Range("E" & RowCount) = _
.Range("E" & (RowCount + 1)) And _
Left(.Range("F" & RowCount), 3) = _
Left(.Range("F" & (RowCount + 1)), 3) And _
.Range("G" & RowCount) = _
.Range("G" & (RowCount + 1)) And _
.Range("A" & RowCount) < _
.Range("A" & (RowCount + 1)) Then

if Duplicate = False then
Start = RowCount
Duplicate = True
end if
Else
If Duplicate = True Then
Duplicate = False
.Rows(Start & ":" & RowCount).Copy _
Destination:=Sheets("Results").Rows(NewRow)
NewRow = NewRow + (RowCount - Start) + 1
End If
End If
RowCount = RowCount + 1
Loop

If Duplicate = True Then
Duplicate = False
.Rows(Start & ":" & RowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRow + 1)
End If
End With

End Sub


"Jcraig713" wrote:

I have code that first looks at house number, if same then look at street
name, if same, look at suite number, if same, look at ID#, if different,
display the results - see below. I have source data that looks like:

A B C D E F G
H I
ParentID BLD StuLast StuFirst Street# Strname Suite# City
Zip
286 AHS Andrus Mat 6847 HIGH TROY 48098
286 WLS Andrus Lauren 6847 HIGH TROY 48098
736 MUE Andrus Chris 6847 HIGH TROY 48098
736 AEL Andrus Emma 6847 HIGH TROY 48098

Currently, My code results in only lauren and chris's record being displayed
in the results page, but I need both records to be displayed when the parent
ID in column a matches.

Any assistance would be greatly appreciated.


Sub GetDuplicates()

With Sheets("PasteDataHere")
'First Sort Data
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set SortRange = .Rows("1:" & LastRow)
SortRange.Sort _
key1:=.Range("E1"), _
order1:=xlAscending, _
key2:=.Range("F1"), _
order2:=xlAscending, _
key3:=.Range("A1"), _
order3:=xlAscending, _
header:=xlYes

NewRow = 1
RowCount = 2
Start = RowCount
Duplicate = False
Do While .Range("A" & RowCount) < ""
If .Range("E" & RowCount) = _
.Range("E" & (RowCount + 1)) And _
Left(.Range("F" & RowCount), 3) = _
Left(.Range("F" & (RowCount + 1)), 3) And _
.Range("G" & RowCount) = _
.Range("G" & (RowCount + 1)) And _
.Range("A" & RowCount) < _
.Range("A" & (RowCount + 1)) Then


Duplicate = True
Else
If Duplicate = True Then
Duplicate = False
.Rows(Start & ":" & RowCount).Copy _
Destination:=Sheets("Results").Rows(NewRow)
NewRow = NewRow + (RowCount - Start) + 1
Else
Start = RowCount + 1
End If
End If
RowCount = RowCount + 1
Loop

If Duplicate = True Then
Duplicate = False
.Rows(Start & ":" & RowCount).Copy _
Destination:=Sheets("Sheet2").Rows(NewRow + 1)
End If
End With

End Sub