Help Change existing Code

[Jcraig713]

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

 

[Joel]

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]

Joel,
You are correct... thanks for providing me this code not too long ago! I
am able to use it intechangeably for different uses which is great. I have a
new use for it tho as I need to identify multiple contacts for the same
family of students, then change them. If all the records are not presented
for amending in the results page, only those students presented inthe results
page will be ID'd for change which is why I want all the records returned for
display that meet the criteria.

I ran this new code against my source data and only the two records are
being returned. I cannot tell you how much I wish I could fix this myslef
and not have to ask for help but any help you can provide woould be so
apprecited.

 

[Joel]

See if this works

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("Results").Rows(NewRow + 1)
End If
End With

End Sub

 

[Jcraig713]

That did the trick... Thanks so much. I looked at the code and do not
notice the difference tho? What changed?

 

[Jcraig713]

Hi Joel,
When I look at the results page more closely, yes, all the records are bring
returned that I want, but it is returning the values when the parent ID is
the same. Only where the parent ID's are different need to be returned when
columns E, F, and G are equal. So in other words, when E, F and G (Street#,
Name and Suffix#) are equal, return all records when there is one difference
in Parent ID (COlumn A). Can this be done? If this cannot be done, I will go
with what I have and rerun the file once all the initial changes are made?

 

[Joel]

I made two changes in the code.

1) How the variable Start variable was being changed.
from

2) I change the parentd ID from not equal to equl. You may want to change
this back to the way it originally was runing

Old
.Range("A" & RowCount) <> _
.Range("A" & (RowCount + 1)) Then

new

.Range("A" & RowCount) = _
.Range("A" & (RowCount + 1)) Then