Automatic sort of table into rank order when a new record is added

Peter Cresswell

New Member
Joined
May 20, 2018
Messages
2
Hi Everyone,
Although I have used Excel to produce simple spread sheets, I am new to using VBA and macros. I am struggling with creating a macro that will do a fairly simple task and I have found a YouTube video that seems to do what I want but having created it by heavily copying from the video it doesn't run against my data table.
The data table has simply two columns Column A records a name and Column B records a time in seconds to 1/100 th of a second. This is for a slot car racing feature at a local charity fete and records and sorts the times and the names with them automatically when a new name and time are added. This is an example of the table.
sprint leader board table.jpg


Name
Time (seconds)
George
20.12
Don
17.64
Pete
21.35
Nick
13.98
allan
17.63
fred
16.46
john
18.27
david
19.04
Ian
17.37
fred 2
16.14

<tbody>
</tbody>


Note the table can be either as long as necessary or have a limit of say top 25 times providing the slowest times drop off the bottom. New data would be added on the next Row.

When a new row is added (name in Col A and time in Col B), when I press 'Enter' I want the table to sort the new data into its position in the current table based on Col B. Below is the macro I have, which as I mentioned above has been heavily borrowed from a youtube video, but my needs are to have a name (i.e alpha characters) in col A whereas the one in the video used numeric.
****Macro***
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Target.Column = 2 Then
Dim lastRow As Long
lastRow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A2:B"&lastrow).Sortkey1:=Range("B2:B"&lastRow),order1:=xlAscending,Header:=xlNo

End If

End Sub
******
A new line of data will be added manually, and on pressing ‘Enter’ I want the table to auto sort with with the lowest time in Col B (and associated name from Col A) to be added to the table in it’s ranking order

The video on YouTube can be viewed at: https://www.bing.com/videos/search?...E5E308D14561DF600E2BE&view=detail&FORM=VIREHT
Hopefully someone here can help me progress this. I have spent a few days trying to make this work without luck so far! I’m now getting desperate as I need it for Saturday!!!!
Many thanks
Pete

<colgroup><col><col></colgroup><tbody>
</tbody>
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Peter

I think the way to go with this is to convert your leader board range into an Excel Table, as this will automatically expand its dimensions when a new row is added (i.e. if new data is entered in a cell immediately under the last row), so there is no need to then be counting rows, etc. as your current code does.

To convert a range to Table:

  1. Select any cell within the table and press Ctrl+T
  2. Check the details (ensure headers are included)
  3. Click Ok

I would then change the name of the Table to something meaningful like "tblLeaderBoard"
  1. Select any cell within the table
  2. Goto to the Table Tools / Design tab on the RHS of the ribbon
  3. The default name of the table will be shown under the Table Name field in the Properties section at far left of screen
  4. Click in the field and over-type with new name (without quotes)

The following code will then sort the table (NOTE: this assumes the sheet object for your worksheet, as shown in the VBE Project Explorer, is Sheet1):

Code:
Sub SortLeaderBoard()

    With Sheet1.ListObjects("tblLeaderBoard")
        .Sort.SortFields.Clear
    
        .Sort.SortFields. _
        Add Key:=Range("tblLeaderBoard[[#All],[Time (seconds)]]"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
        
        With .Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
    End With
End Sub

The tricky bit is detecting when new data has been added to the table to then trigger execution of the sort.
The code you've copied attempts this via the Worksheet_Change Event - but I think the way it identifies the target range is a bit clunky and can be done better using the VBA objects related to Tables rather than counting sheet rows. However, it's very late on a Friday night where I am so I'll have to postpone working out how to complete this part until a later time (expect sometime this weekend)
 
Upvote 0
I did a last quick web search before going to bed and found the key part of this code:

Copy this into the Sheet1 sheet object of the VBE Project Explorer.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng As Range

Set Rng = Sheet1.ListObjects("tblLeaderBoard").ListColumns(2).DataBodyRange

    If Not (Application.Intersect(Target, Rng) Is Nothing) Then
        
        Call SortLeaderBoard        'Executes standard sub-routine in Module1
        
    End If
End Sub

I think the identification of your "Time (Seconds)" column could be more direct (& therefore robust should you insert a column) than "Sheet1.ListObjects("tblLeaderBoard").ListColumns(2)" but I couldn't find how to do that (whilst Tables has a number of benefits, they are a different animal to standard ranges, as are all their objects, methods and properties!)
 
Upvote 0
Peter

To directly/always reference the "Time (Seconds)" field in your table rather than use the column index number, replace the 2nd line of code with the following:

Code:
Set Rng = Sheet1.ListObjects("tblLeaderBoard").ListColumns([B][COLOR=#ff0000]"Time (seconds)"[/COLOR][/B]).DataBodyRange

Simple really!! :)


Does the Table construct and these two pieces of code now provide the solution you were seeking?
 
Upvote 0

Forum statistics

Threads
1,214,915
Messages
6,122,214
Members
449,074
Latest member
cancansova

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