Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 32
Default 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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default 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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Really Help with existing VBA code... Cam Excel Programming 4 August 19th 08 05:59 PM
Modify existing code to dynamic code Ixtreme Excel Programming 5 August 31st 07 11:42 AM
Can I use code/macro to change code/macro in an existing file? Scott Bedows Excel Programming 2 February 14th 07 05:50 AM
Help with existing code ploddinggaltn Excel Discussion (Misc queries) 1 November 27th 06 09:46 PM
VBA code to change registry value of existing DSN Alan[_34_] Excel Programming 1 October 18th 05 08:15 PM


All times are GMT +1. The time now is 06:35 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"