Sort and filter macro

K

KH_GS

Hi

I recorded a macro, trying to sort a column and then filter it paste to
a new column.

Does anyone find the code exceptionally long? I suspect it can be coded
neater but I'm novice. :confused:



Code:
--------------------
Sub SortFilter ()

Columns("D:D").Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Columns("D:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F1" _
), Unique:=True
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
End Sub
 
N

Norman Jones

Hi KH,

Try, perhaps:

'=============>>
Sub SortFilter()

With Columns("D:D")
.Sort Key1:=Range("D2"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("F1"), _
Unique:=True
End With

End Sub
'<<=============
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Excel Macro delete certail column's 1
fixing a run-time error'9': Subscript out of range 0
Where am I going wrong? 2
Need Help with VBA code for an Excel Model Macro 5
Copy several photos in a macro 2
Macro that deletes and pastes filterd rows and then some 2
Macro to hide rows with a certain cell empty then set print area and print 12
Retaining data on clipboard after close without prompt. 1

Top