Creating Code??

[Jcraig713]

My spreadsheet data look like this:

A B C D E F G
H
hlduniq Sclname StuLast Stufirst house# StrNam City Zip
99 BldgA Black John 100 Second Detroit 48330
100 BldgA Smith Jane 133 Main Detroit 48332
100 BldgB Smith John 133 Main Detroit 48332
101 BldgA Doe Jane 1001 First Detroit 48331
102 BldgB Doe John 1001 First Detroit 48332

What I would like the code to do is to return just the two rows (the Doe's
on the bottom) that the house number and the first three digits of the street
name are the same, but the household unique ID differs. In my system, this
is a duplicate address that needs to be amended to one house unique. I just
need a way to not have to manually look through 10,000 records by hand. Can
this be done? Can you help?

 

[joel]

The code is a little complicated because I didn't know if you would find more
than two rows that met the criteria. It sorted the data to get the rows in
order to make the code simplier. If you had two rows where the hlduniq and a
thrid line that didn't then only the 2nd and 3rd will be moved.

The code expects the source data to be in Sheet1 and it will move the data
that meets the criteria to Sheet2.

Sub GetDuplicates()

With Sheets("Sheet1")
'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("A" & RowCount) <> _
.Range("A" & (RowCount + 1)) Then

Duplicate = True
Else
If Duplicate = True Then
Duplicate = False
.Rows(Start & ":" & RowCount).Copy _
Destination:=Sheets("Sheet2").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

 

[AGP]

My spreadsheet data look like this:

A B C D E F G
H
hlduniq Sclname StuLast Stufirst house# StrNam City Zip
99 BldgA Black John 100 Second Detroit 48330
100 BldgA Smith Jane 133 Main Detroit 48332
100 BldgB Smith John 133 Main Detroit 48332
101 BldgA Doe Jane 1001 First Detroit 48331
102 BldgB Doe John 1001 First Detroit 48332

What I would like the code to do is to return just the two rows (the Doe's
on the bottom) that the house number and the first three digits of the
street
name are the same, but the household unique ID differs. In my system,
this
is a duplicate address that needs to be amended to one house unique. I
just
need a way to not have to manually look through 10,000 records by hand.
Can
this be done? Can you help?

yes it can be done. look in the Excel VBA help system to learn how to write
a VBA macro.
use cell.value() and iterate through the cells that you mbneed to cover.

AGP

 

[Jcraig713]

Joel, Thanks so much. I cannot begin to say it enough. The code work
beatifully. May I ask, if I wanted to add an apt number (just after street
name in Column G), is there a way to get the code to look at it too? I did
not think of those addresses that are the same but are only different by the
apt number? Some records in column G will be blank as they are houses. Can
we amend the code to accomodate an apt number?

 

[joel]

I just changed the IDF statement below to add column G

from:
If .Range("E" & RowCount) = _
.Range("E" & (RowCount + 1)) And _
Left(.Range("F" & RowCount), 3) = _
Left(.Range("F" & (RowCount + 1)), 3) And _
.Range("A" & RowCount) <> _
.Range("A" & (RowCount + 1)) Then

to:
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)) Then
.Range("A" & RowCount) = _
.Range("A" & (RowCount + 1)) Then

 

[Jcraig713]

I pasted the TO: version of the code in my area and when I run the code, I
get a compile error syntax error with the folling rows highlighted:

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

A message states it expects the end of a statement. Any ideas?

 

[joel]

I did a copy and paste and go tit wrong. should of been

If .Range("E" & RowCount) = _
.Range("E" & (RowCount + 1)) And _
Left(.Range("F" & RowCount), 3) = _
Left(.Range("F" & (RowCount + 1)), 3) And _
.Range("A" & RowCount) <> _
.Range("A" & (RowCount + 1)) Then


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

 

[Jcraig713]

Joel,
I cannot beginto tell you how much time you are going to dave me. Thanks so
much. How does one learn to do this? I wish I could pay it forward somehow.
I would love to learn how to do this; what you did for me. Thanks... Janell