+ Reply to Thread
Results 1 to 3 of 3

Looking to shorten VBA code

Hybrid View

swhite7 Looking to shorten VBA code 07-02-2013, 05:55 PM
kalak Re: Looking to shorten VBA... 07-02-2013, 06:03 PM
tigeravatar Re: Looking to shorten VBA... 07-02-2013, 06:31 PM
  1. #1
    Registered User
    Join Date
    07-02-2013
    Location
    Houston
    MS-Off Ver
    Excel 2010
    Posts
    1

    Looking to shorten VBA code

    Hello, I am very new to Excel and trying to learn how to shorten a marco that is recorded. Looking at the VBA code below, can you please offer any tips or advice to shorten the code. I am looking more for an explination of some things as opposed to someone solving shortening the code so I can learn. Thank you!

    ' SortTop5_2012 Macro
    '
    ' Keyboard Shortcut: Ctrl+t
    ' Filter the data to obtain the players with the highest points
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        ActiveWorkbook.Worksheets("Top30-2012").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Top30-2012").Sort.SortFields.Add Key:=Range( _
            "H2:H31"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Top30-2012").Sort
            .SetRange Range("B1:S31")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
         ' Copy the top 5 players with the highest points from the master list to the top 5 worksheet
        Rows("1:6").Select
        Selection.Copy
        Sheets("Top5-2012").Select
        Range("A1").Select
        ActiveSheet.Paste
        Range("A1").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "Points"
        ' Filter the data to obtain the players with the highest goals
        Sheets("Top30-2012").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        ActiveWorkbook.Worksheets("Top30-2012").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Top30-2012").Sort.SortFields.Add Key:=Range( _
            "F2:F31"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Top30-2012").Sort
            .SetRange Range("B1:S31")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        ' Copy the top 5 players with the highest goals from the master list to the top 5 worksheet
        Rows("1:6").Select
        Selection.Copy
        Sheets("Top5-2012").Select
        Range("A8").Select
        ActiveSheet.Paste
        Range("A8").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "Goals"
        ' Filter the data to obtain the players with the highest +/-
        Sheets("Top30-2012").Select
        Range("B1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        ActiveWorkbook.Worksheets("Top30-2012").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Top30-2012").Sort.SortFields.Add Key:=Range( _
            "I2:I31"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("Top30-2012").Sort
            .SetRange Range("B1:S31")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        ' Copy the top 5 players with the highest +/- from the master list to the top 5 worksheet
        Rows("1:6").Select
        Selection.Copy
        Sheets("Top5-2012").Select
        Range("A15").Select
        ActiveSheet.Paste
        Range("A15").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = """+/-"""
    End Sub
    Last edited by swhite7; 07-02-2013 at 06:50 PM. Reason: Update Tags

  2. #2
    Valued Forum Contributor
    Join Date
    03-21-2013
    Location
    cyberia
    MS-Off Ver
    Excel 2007
    Posts
    457

    Re: Looking to shorten VBA code

    could you
    (a) put code tags so code is easier to read?
    (b) explain what it's supposed to achieve?

  3. #3
    Forum Expert tigeravatar's Avatar
    Join Date
    03-25-2011
    Location
    Colorado, USA
    MS-Off Ver
    Excel 2003 - 2013
    Posts
    5,361

    Re: Looking to shorten VBA code

    swhite7,

    Welcome to the forum! In the future, please wrap your code in code tags (link in my sig for how).
    As for your question, here is a re-written version of your code. I have included comments to help you understand.
    You may want to look up the Range.Sort method in order to really learn what the code is doing.
    SortTop5_2012 Macro
    'Keyboard Shortcut: Ctrl+t
        
        'Declare variables
        Dim wsTop30 As Worksheet    'Variable that is assigned to the "Top30-2012" worksheet
        Dim wsTop5 As Worksheet     'Variable that is assigned to the "Top5-2012" worksheet
        
        'Assign values to worksheet variables
        Set wsTop30 = Sheets("Top30-2012")
        Set wsTop5 = Sheets("Top5-2012")
        
        'Use the With statement to define the sort range
        'The sort range is from wsTop30 range B1 to wsTop30 last populated cell in column S
        With wsTop30.Range("B1", wsTop30.Cells(Rows.Count, "S").End(xlUp))
            
            'Sort the data to obtain the players with the highest points (sort descending by column H)
            .Sort Intersect(.Cells, .Parent.Columns("H")), xlDescending, Header:=xlYes
            wsTop30.Range("1:6").Copy Destination:=wsTop5.Range("A1")
            wsTop5.Range("A1").Value = "Points"
            
            'Sort the data to obtain the players with the highest goals (sort descending by column F)
            .Sort Intersect(.Cells, .Parent.Columns("F")), xlDescending, Header:=xlYes
            wsTop30.Range("1:6").Copy Destination:=wsTop5.Range("A8")
            wsTop5.Range("A8").Value = "Goals"
            
            'Sort the data to obtain the players with the highest +/- (sort descending by column I)
            .Sort Intersect(.Cells, .Parent.Columns("I")), xlDescending, Header:=xlYes
            wsTop30.Range("1:6").Copy Destination:=wsTop5.Range("A15")
            wsTop5.Range("A15").Value = """+/-"""
        End With
        
        'Object variable cleanup
        Set wsTop30 = Nothing
        Set wsTop5 = Nothing
        
    End Sub
    Hope that helps,
    ~tigeravatar

    Forum Rules: How to use code tags, mark a thread solved, and keep yourself out of trouble

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1