seperation of duplicates copy latest date and old date

[realtop17]

Hi good day,


question:


How can i seperate duplicate copy latest date and old date in seperate sheet automatically. let say sheet1 is my refernce i want the old date transfer to sheet2.


like ex: see below

sheet1

[pre]

1   s/n      date
2    ab      july 1,2012
3    cd      august 2,2012
4    ef      sept. 3,2012
5     ab     dec. 1,2012
6     cd     dec. 20,2012
7     ef     dec. 25,2012
I want my output like these. see below


sheet1 have latest date see below

[pre][code]1     s/n    dates
2     ab     dec. 1,2012
3     cd     dec. 20,2012
4     ef     dec. 25,2012

[/pre]
then sheet2 have old date see below.

1 s/n dates
2 ab july 1,2012
3 cd august 2,2012
4 ef sept. 3,2012[/code][/pre]
pls help!


thank you,

realtop17

 

[Faseeh]

Hi realtop17,


Asssuming your data is present in A1:C7 like below:

[pre]

1	s/n	Date
2	ab	1-Jul-12
3	cd	2-Aug-12
4	ef	3-Sep-12
5	ab	1-Dec-12
6	cd	20-Dec-12
7	ef	25-Dec-12

Please format date as Date not text. create following table in E1:H4:

[code]S/n	Sheet1 / New	S/n	Sheet2 / Old
ab	1-Dec-12	ab	1-Jul-12
cd	20-Dec-12	cd	2-Aug-12
ef	25-Dec-12	ef	3-Sep-12[/pre]
For Latest date, enter in F2, 


=LARGE(IF($B$2:$B$7=E2,$C$2:$C$7),1)

For Oldest date, Enter in H2


=SMALL(IF($B$2:$B$7=E2,$C$2:$C$7),1)[/code]


press Ctrl+Shift+Enter for both and Drag down.


Regards,

 

[realtop17]

Hi Faseeh,


thank you for your effort.

what i mean is sheet1 is my reference then using formula all new date of duplicate serials in sheet1 remains and the old date transfer to sheet2 automatically.


thank you,

realtop17

 

[Debraj]

Hi Raltop17!


In addition to your last post, where Narayank991 provide a great solution, I have just adapt the same in this code also.


Goto VBA (Alt + F11) > Insert New Module and paste the below code there.

[pre]

Sub MoveOldData()
Dim lr As Long, i As Long, j As Long
j = 1
With Worksheets("Sheet1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lr To 2 Step -1
.[d2] = .Range("A" & i)
.Range("E2").FormulaArray = "=MAX(IF($A$2:$A$19=$D$2,$B$2:$B$19))"
If .Range("B" & i) < Range("E2") Then
j = j + 1
.Range("a" & i & ":B" & i).Copy Worksheets("Sheet2").Range("a" & j)
.Range("a" & i & ":B" & i).Delete xlShiftUp
End If
Next i
End With
Range("D2:E2").Clear
End Sub

[/pre]

Press F5, and it will move all Old Data to next Sheet..

Please let us know if its working for you..


Regards,

Deb

 

[realtop17]

Hi debraj roy, NARAYANK991,


yes! yes! yes! its working thank you very much guys your the man! Just one thing


can you adjust the VBA CODE for insert module my actual work sheet is look like below. sory i'm VBA code beginner.

[pre]

date 	CUSTOMER NAME	PART NUMBER	serial no.	Remarks	cntrl.No updateby
1/1/2012  me             12              ab            dis assy     1       u
1/1/2012  me             34              cd            reference    2       u
1/1/2012  me             56              ef            reference    3       u
2/2/2012  me             12              ab            dis assy     1       u
2/2/2012  me             34              cd            reference    2       u
2/2/2012  me             56              ef            reference    3       u

[/pre]
thank you,

realtop17

 

[Luke M]

Hi realtop!

Tweaking Deb's code a little, this code will transfer all the data from the row. Should also run a little faster.

[pre]

Sub ExtractOld()
Dim lr As Long, i As Long, j As Long
Dim xName As String

j = 2
Application.ScreenUpdating = False
With Worksheets("Sheet1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lr To 2 Step -1
xName = .Cells(i, "D").Value
If WorksheetFunction.CountIf(.Range(.Cells(lr, "D"), .Cells(i, "D")), xName) > 1 Then
.Rows(i).Copy Worksheets("Sheet2").Rows(j)
j = j + 1
.Rows(i).Delete xlShiftUp
End If
Next i
End With
Application.ScreenUpdating = True

End Sub

[/pre]

 

[realtop17]

Thank you very very much luke, debraj and faseeh, its working a little slowly but its okey.again thank you very very much guys and also thank you for chandoo for this site clap! clap! clap! wowwwwwwwww.....


thank you and god bless,

realtop17


yes!!!!!!!

 

[Luke M]

Thanks for the kind words realtop, glad we could help out.