Search Contextures Sites
Custom Search

Excel: Sort Data With VBA

With the code in this example, you can make it easier to sort data, and help prevent scrambled data. Invisible rectangles are added at the top of the columns, and when a rectangle is clicked, a macro runs.

Sort Data With Invisible Rectangles  
Video: Sort Data With Invisible Rectangles
Create the Invisible Rectangles  
Use VBA to Sort Data  
Sort Data Tutorials  

Sort Data With Invisible Rectangles

Thanks to Dave Peterson, who wrote this technique.

To make it easier for users to sort data, and to help prevent scrambled data, you can add invisible rectangles at the top of your columns. When a rectangle is clicked, a macro runs.

In the macro, the whole data range is selected, and the data is sorted by the column in which the rectangle was clicked. The zipped sample workbook can be downloaded here:

Watch the steps in this Sort with Shapes video, and read the detailed instructions below.

Create the Invisible Rectangles

Run the following code once, to create the rectangles at the top of the table. You can change the iCol variable, to match the number of columns in your table.

To run the code, copy it to a regular code module, and edit the code, if necessary, by changing the iCol variable, and starting cell, to match your worksheet.

Then on the Excel Ribbon, click the View tab, and click Macros. Select the SetupOneTime macro, and click the Run button.

Sub SetupOneTime()

'adds rectangle at top of each column
'code written by Dave Peterson 2005-10-22
  Dim myRng As Range
  Dim myCell As Range
  Dim curWks As Worksheet
  Dim myRect As Shape
  Dim iCol As Integer
  Dim iFilter As Integer
  iCol = 7  'number of columns
' 2010-Oct-31 added space for autofilter dropdowns
' set iFilter to 0 if not using autofilter
  iFilter = 12 'width of drop down arrow
  Set curWks = ActiveSheet

  With curWks
    Set myRng = .Range("a1").Resize(1, iCol)
    For Each myCell In myRng.Cells
        With myCell
          Set myRect = .Parent.Shapes.AddShape _
              (Type:=msoShapeRectangle, _
              Top:=.Top, Height:=.Height, _
              Width:=.Width - iFilter, Left:=.Left)
        End With
        With myRect
          .OnAction = ThisWorkbook.Name & "!SortTable"
''        2010-Oct-31 revised to fill shapes in Excel 2007
''          .Fill.Visible = False
          .Fill.Transparency = 1#
          .Line.Visible = False
        End With
    Next myCell
  End With
End Sub

Use VBA to Sort Data

The following code runs when one of the rectangles is clicked. You can change the TopRow, iCol and strCol variables, to match the layout of your table.

Sub SortTable()
  'code written by Dave Peterson 2005-10-22
  '2006-08-06 updated to accommodate hidden rows
  Dim myTable As Range
  Dim myColToSort As Long
  Dim curWks As Worksheet
  Dim mySortOrder As Long
  Dim FirstRow As Long
  Dim TopRow As Long
  Dim LastRow As Long
  Dim iCol As Integer
  Dim strCol As String
  Dim rng As Range
  Dim rngF As Range

  TopRow = 1
  iCol = 7  'number of columns in the table
  strCol = "A"  ' column to check for last row

  Set curWks = ActiveSheet

  With curWks
    LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row
    If Not .AutoFilterMode Then
        Set rng = .Range(.Cells(TopRow, strCol), _
                .Cells(LastRow, strCol))
        Set rng = .AutoFilter.Range
    End If
    Set rngF = Nothing
    On Error Resume Next
    With rng
       'visible cells in first column of range
       Set rngF = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
    End With
    On Error GoTo 0
    If rngF Is Nothing Then
         MsgBox "No visible rows. Please try again."
         Exit Sub
         FirstRow = rngF(1).Row
    End If
    myColToSort = .Shapes(Application.Caller).TopLeftCell.Column
    Set myTable = .Range(strCol & TopRow & ":" _
        & strCol & LastRow).Resize(, iCol)
    If .Cells(FirstRow, myColToSort).Value _
      < .Cells(LastRow, myColToSort).Value Then
        mySortOrder = xlDescending
        mySortOrder = xlAscending
    End If
    myTable.Sort key1:=.Cells(FirstRow, myColToSort), _
              order1:=mySortOrder, _
  End With

End Sub

Sort Data Tutorials

1. Sort Data -- Basics
2. Sort Data -- VBA





30 Excel Functions in 30 Days








Privacy Policy


Contextures Inc., Copyright 2016
All rights reserved.


Last updated: May 20, 2015 7:51 PM