Vbs macro that sorts and copies two columns and paste to selected worksheet

D

DenniBrink

New Member
Joined
Jul 31, 2016
Messages
46
Hello everyone! I am trying to learn something new and need guidance. Please offer suggestions on how I can improve the VBS script listed:

Sub SATFILTER()
' SATFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Saturday by the AutoFilter Field:=1 "NS".


Range("B8:C38").Select
Selection.Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=1, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087/3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "FSS", "SPSS/APBS"), _
Operator:=xlFilterValues
ActiveWindow.SmallScroll Down:=-3
Range("B8:C56").Select
Selection.Copy
Sheets("SAT_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=1
Sheets("SAT_ASSIGNMENTS").Select
ActiveWindow.SmallScroll Down:=0
End Sub
<strike></strike>
 
Sort by date Sort by votes
Try this
Code: 
Sub SATFILTER()
 ' SATFILTER Macro
 ' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Saturday by the AutoFilter Field:=1 "NS".
 Sheets("SAT_ASSIGNMENTS").Range("B8:C38").Clear
 Sheets("MASTER DAILY SCHED").Range("$C$4:$I$56").AutoFilter Field:=1, Criteria1:=Array( _
 "3003/3009", "3070/3017", "3070/3086", "3087/3088/3089", "3090/3091", "3092/3093", _
 "AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "FSS", "SPSS/APBS"), _
 Operator:=xlFilterValues
 Sheets("MASTER DAILY SCHED").Range("B8:C56").SpecialCells(xlCellTypeVisible).Copy Sheets("SAT_ASSIGNMENTS").Range("B8")
 Sheets("MASTER DAILY SCHED").AutoFilterMode = False
 Sheets("SAT_ASSIGNMENTS").Select
 End Sub
 
Last edited:
Upvote 0
It works amazingly fast with no screen flicker! What lines in the code do I need to modify for Sunday - Friday?
 
Upvote 0
= What lines in the code do I need to modify for Sunday - Friday?
Click to expand...

I have no idea. I cannot see your worksheet!
Regards, JLG
 
Last edited:
Upvote 0
Here is the macro code for the other worksheets:

Sub SUNFILTER()
' SUNFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Sunday.

Range("B8:C38").Select
Selection.Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=2, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3092/3093", "AFCS", _
"AFSM", "APPS #1", "APPS #2", "DBCS", "FSS", "SPSS/APBS"), Operator:= _
xlFilterValues
Range("B8:B56").Select
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("B8:B56,D8:D56").Select
Range("D8").Activate
Selection.Copy
Sheets("SUN_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=2
Sheets("SUN_ASSIGNMENTS").Select
End Sub

Sub MONFILTER()
' MONFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Monday.

Range("B8:C38").Select
Selection.Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=3, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "FSS", "HSTS", "SPSS/APBS"), Operator _
:=xlFilterValues
Range("B6:B56").Select
ActiveWindow.SmallScroll Down:=-21
Range("B6:B56,E6:E56").Select
Range("E6").Activate
Selection.Copy
Sheets("MON_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=18
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=3
Sheets("MON_ASSIGNMENTS").Select
ActiveWindow.SmallScroll Down:=0
End Sub

Sub TUEFILTER()
' TUEFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Tuesday.

Range("B8:C38").Select
Selection.Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=4, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "Engine Rm", "FSS", _
"HSTS", "SPSS/APBS"), Operator:=xlFilterValues
Range("B6:B55").Select
ActiveWindow.SmallScroll Down:=-24
Range("B6:B55,F6:F55").Select
Range("F6").Activate
Selection.Copy
Sheets("TUE_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=24
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=4
Sheets("TUE_ASSIGNMENTS").Select
ActiveWindow.SmallScroll Down:=-6
End Sub

Sub WEDFILTER()
' WEDFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Wednesday.

Range("B8:C39").Select
Selection.Clear
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=5, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "Engine Rm", "FSS", _
"HSTS", "SPSS/APBS"), Operator:=xlFilterValues
Range("B6:B54").Select
ActiveWindow.SmallScroll Down:=-21
Range("B6:B54,G6:G54").Select
Range("G6").Activate
Selection.Copy
Sheets("WED_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-6
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=5
Sheets("WED_ASSIGNMENTS").Select
End Sub

Sub THURFILTER()
' THURFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Thursday.

Range("B8:C38").Select
Selection.Clear
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=6, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "Engine Rm", "FSS", _
"SPSS/APBS"), Operator:=xlFilterValues
Range("B6:B56").Select
ActiveWindow.SmallScroll Down:=-27
Range("B6:B56,H6:H56").Select
Range("H6").Activate
Selection.Copy
Sheets("THU_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=21
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=6
Sheets("THU_ASSIGNMENTS").Select
ActiveWindow.SmallScroll Down:=-6
End Sub

Sub FRIFILTER()
' FRIFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Friday.


Range("B8:C38").Select
Selection.Clear
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=7, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087/3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "Engine Rm", "FSS", _
"SPSS/APBS"), Operator:=xlFilterValues
Range("B6:B56").Select
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("B6:B56,I6:I56").Select
Range("I6").Activate
Selection.Copy
Sheets("FRI_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-6
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
ActiveWindow.ScrollWorkbookTabs Sheets:=-1
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=7
Sheets("FRI_ASSIGNMENTS").Select
End Sub




<strike></strike>
 
Upvote 0
Greetings everyone! After further studying I learned where I can improve the VBS script. Please review the following:

Sub SATFILTER()
' SATFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Saturday.
Application.ScreenUpdating = False
Sheets("SAT_ASSIGNMENTS").Select
Range("B8:C38").Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=1, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087/3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "FSS", "SPSS/APBS"), _
Operator:=xlFilterValues
ActiveWindow.SmallScroll Down:=-3
Range("B8:C56").Select
Selection.Copy
Sheets("SAT_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Sheets("MASTER DAILY SCHED").Range("$C$4:$I$56").AutoFilter Field:=1
Sheets("SAT_ASSIGNMENTS").Select
Application.ScreenUpdating = True
End Sub

Sub SUNFILTER()
' SUNFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Sunday.
Application.ScreenUpdating = False
Sheets("SUN_ASSIGNMENTS").Select
Range("B8:C38").Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=2, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3092/3093", "AFCS", _
"AFSM", "APPS #1", "APPS #2", "DBCS", "FSS", "SPSS/APBS"), Operator:= _
xlFilterValues
Range("B8:B56").Select
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("B8:B56,D8:D56").Select
Range("D8").Activate
Selection.Copy
Sheets("SUN_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Sheets("MASTER DAILY SCHED").Range("$C$4:$I$56").AutoFilter Field:=2
Sheets("SUN_ASSIGNMENTS").Select
Application.ScreenUpdating = True
End Sub

Sub MONFILTER()
' MONFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Monday.
Application.ScreenUpdating = False
Sheets("MON_ASSIGNMENTS").Select
Range("B8:C38").Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=3, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "FSS", "HSTS", "SPSS/APBS"), Operator _
:=xlFilterValues
Range("B6:B56").Select
ActiveWindow.SmallScroll Down:=-21
Range("B6:B56,E6:E56").Select
Range("E6").Activate
Selection.Copy
Sheets("MON_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Sheets("MASTER DAILY SCHED").Range("$C$4:$I$56").AutoFilter Field:=3
Sheets("MON_ASSIGNMENTS").Select
Application.ScreenUpdating = True
End Sub

Sub TUEFILTER()
' TUEFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Tuesday.
Application.ScreenUpdating = False
Sheets("TUE_ASSIGNMENTS").Select
Range("B8:C38").Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=4, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "Engine Rm", "FSS", _
"HSTS", "SPSS/APBS"), Operator:=xlFilterValues
Range("B6:B55").Select
ActiveWindow.SmallScroll Down:=-24
Range("B6:B55,F6:F55").Select
Range("F6").Activate
Selection.Copy
Sheets("TUE_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Sheets("MASTER DAILY SCHED").Range("$C$4:$I$56").AutoFilter Field:=4
Sheets("TUE_ASSIGNMENTS").Select
Application.ScreenUpdating = True
End Sub

Sub WEDFILTER()
' WEDFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Wednesday.
Application.ScreenUpdating = False
Sheets("WED_ASSIGNMENTS").Select
Range("B8:C39").Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=5, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "Engine Rm", "FSS", _
"HSTS", "SPSS/APBS"), Operator:=xlFilterValues
Range("B6:B54").Select
ActiveWindow.SmallScroll Down:=-21
Range("B6:B54,G6:G54").Select
Range("G6").Activate
Selection.Copy
Sheets("WED_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Sheets("MASTER DAILY SCHED").Range("$C$4:$I$56").AutoFilter Field:=5
Sheets("WED_ASSIGNMENTS").Select
Application.ScreenUpdating = True
End Sub

Sub THURFILTER()
' THURFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Thursday.
Application.ScreenUpdating = False
Sheets("THU_ASSIGNMENTS").Select
Range("B8:C38").Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=6, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087", "3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "Engine Rm", "FSS", _
"SPSS/APBS"), Operator:=xlFilterValues
Range("B6:B56").Select
ActiveWindow.SmallScroll Down:=-27
Range("B6:B56,H6:H56").Select
Range("H6").Activate
Selection.Copy
Sheets("THU_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Sheets("MASTER DAILY SCHED").Range("$C$4:$I$56").AutoFilter Field:=6
Sheets("THU_ASSIGNMENTS").Select
Application.ScreenUpdating = True
End Sub

Sub FRIFILTER()
' FRIFILTER Macro
' Filters Master Daily Schedule Worksheet for Employees Assigned to Work Friday.
Application.ScreenUpdating = False
Sheets("FRI_ASSIGNMENTS").Select
Range("B8:C38").Clear
Sheets("MASTER DAILY SCHED").Select
ActiveSheet.Range("$C$4:$I$56").AutoFilter Field:=7, Criteria1:=Array( _
"3003/3009", "3070/3017", "3070/3086", "3087/3088/3089", "3090/3091", "3092/3093", _
"AFCS", "AFSM", "APPS #1", "APPS #2", "DBCS", "E. Battery Rm", "Engine Rm", "FSS", _
"SPSS/APBS"), Operator:=xlFilterValues
Range("B6:B56").Select
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("B6:B56,I6:I56").Select
Range("I6").Activate
Selection.Copy
Sheets("FRI_ASSIGNMENTS").Select
Range("B8").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=0
Sheets("MASTER DAILY SCHED").Range("$C$4:$I$56").AutoFilter Field:=7
Sheets("FRI_ASSIGNMENTS").Select
Application.ScreenUpdating = True
End Sub


Any suggestions on how the VBS script can be improved I would appreciate very much. All the best!

<strike></strike>
 
Upvote 0
I discovered some unnecessary lines in the VBS script. I deleted many of the ActiveWindow.SmallScroll Down:= statements and redundant Range().Selects. I ran the VBS Debugger (F8) to identify any problems. The filter VBS macros work very well.

Don't understand how the VBS Autofilter is able to define and remove the "NS" from the selected ranges. Can anyone explain?
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Vbs autofilter copy and paste subroutine
Replies
3
Views
4K
DenniBrink
D
D
  • Question Question
Excel vbs code for dynamic range referencing
Replies
1
Views
4K
mumps
mumps

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top