Previous Topic Next Topic

Seperate column into 2 parts with ordering

Closed
Carman - Jul 16, 2010 at 04:10 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jul 16, 2010 at 06:49 AM
Hello,

bascially, i have got a column consist of data that i want those starts with "EMUA-I" to be place at the front, with the ascending order of date. Then i want the "non EMUA-I" part to be placed at the back with the ascending order of date.

please take a look at this reference file :
https://authentification.site/files/23397356/1.xls

I need VBA script to perform the job as this documents need future update.

Thanks
Related:

1 response

Answer 1 / 1
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jul 16, 2010 at 06:49 AM
I have added two criteria ranges H1 to I2 and K1 to L2.
see this in this modified file "1 carman.xls" and download it from the following url


http://www.speedyshare.com/files/23399124/1_carman.xls


the result you can see in sheet 2

the macro "test" is in vbeditosr but also given below 


Sub test()
Dim r As Range, crit1 As Range, crit2 As Range
Dim dest1 As Range, dest2 As Range, r1 As Range
Worksheets("sheet2").Cells.Clear
Worksheets("sheet1").Activate
Set r = Range(Range("A1"), Range("A1").End(xlDown).Offset(0, 1))
Set crit1 = Range(Range("H1"), Range("H1").Offset(1, 1))
'MsgBox crit1.Address
Set crit2 = Range(Range("K1"), Range("K1").Offset(0, 1).Offset(1, 1))
Set dest1 = Range("A1").End(xlDown).Offset(5, 0)

Set dest2 = dest1.Offset(0, 4)

r.AdvancedFilter action:=xlFilterCopy, CriteriaRange:=crit1, CopyToRange:=dest1
r.AdvancedFilter action:=xlFilterCopy, CriteriaRange:=crit2, CopyToRange:=dest2
Set r = Range(dest1, dest1.End(xlDown).Offset(0, 1))
r.Sort key1:=dest1.Offset(0, 1), header:=xlYes
Set r1 = Range(dest2, dest2.End(xlDown).Offset(0, 1))
r1.Sort key1:=dest2.Offset(0, 1), header:=xlYes
r.Copy Worksheets("sheet2").Range("A1")
r1.Offset(1, 0).Copy Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Range(dest1, Cells(Rows.Count, "A")).EntireRow.Delete

End Sub
0