VBA Code for a template

I/ATech

New Member
Joined
Apr 22, 2009
Messages
29
Learning VBA. We race endurance and use a datalogger that logs RPM every tenth of a second, which I download and convert to .xlsx. Each driver runs approximately 2 hours, so there are around 72,000 data lines per driver. Using the macro recorder, I cobbled together code that adds a column of sequence, 1 to however many, and then I want to sort the sheet by RPM, largest to smallest. I don’t think I have the code in a form to be able to create a template (.xltm), so it can be used multiple times. (I created this on a sheet named John1 (3)). Thank you advance for any help.

JohnTimeTime (s)Distance [feet]MX5 RPM [rpm]
Lap: 101.43.635
0​
0​
0​
0.1​
0​
0​
0.2​
0​
0​
0.3​
0​
0​
0.4​
0​
0​
0.5​
0​
0​
0.6​
0​
0​
0.7​
0​
0​
0.8​
0​
0​
0.9​
0​
0​
1​
0​
0​
1.1​
0​
160.338​
1.2​
0​
801.926​
1.3​
0​
803.336​
1.4​
0​
1055.296​
1.5​
0​
1300.443​
1.6​
0.01​
1425.19​
1.7​
0.01​
1545.473​


Sub AddSeqAndSortMaxRPM()
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Seq"
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").AutoFill Range("A2:A" & Range("E" & Rows.Count).End(xlUp).Row), xlFillSeries
ActiveWorkbook.Worksheets("John1 (3)").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("John1 (3)").Sort.SortFields.Add2 Key:=Range( _
"F2:F32398"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("John1 (3)").Sort
.SetRange Range("A1:F32398")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
JohnTimeTime (s)Distance [feet]MX5 RPM [rpm]
Lap: 101.43.635000
0.100
0.200
0.300
0.400
0.500
0.600
0.700
0.800
0.900
100
1.10160.338
1.20801.926
1.30803.336
1.401055.296
1.501300.443
1.60.011425.19
1.70.011545.473

Perhaps something like this?
VBA Code:
Sub AddSeqAndSortMaxRPM()
    Dim RpmSortSheet As Worksheet
    Dim SortRange As Range
    
    Set RpmSortSheet = ActiveSheet
    
    Select Case MsgBox("This action will sort worksheet '" & RpmSortSheet.Name & "' by rpm. " & vbCrLf _
            & "" & vbCrLf _
            & "Continue?", vbOKCancel Or vbQuestion, Application.Name)
        Case vbCancel
            Exit Sub
    End Select
    
    With RpmSortSheet
        If .Range("A1") <> "Seq" Then
            .Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Set SortRange = .Range("A1:F" & .Range("F" & .Rows.Count).End(xlUp).Row)
            With SortRange
                .Range("A1").Value = "Seq"
                .Range("A2").Value = "1"
                .Range("A2").AutoFill .Offset(1).Resize(.Rows.Count - 1, 1), xlFillSeries
                .Sort Key1:=.Columns("F"), Order1:=xlDescending, Header:=xlYes
            End With
        Else
            Select Case MsgBox("This worksheet has already been sorted by rpm " & vbCrLf _
                    & "" & vbCrLf _
                    & "Revert to original order?", vbYesNo Or vbQuestion, Application.Name)
                Case vbYes
                    Set SortRange = .Range("A1:F" & .Range("F" & .Rows.Count).End(xlUp).Row)
                    SortRange.Sort Key1:=.Columns("A"), Order1:=xlAscending, Header:=xlYes
                    RpmSortSheet.Range("A1").EntireColumn.Delete
            End Select
        End If
    End With
End Sub


which I download and convert to .xlsx

That seems like the bigger task and one that would be more beneficial to automate. Your sort code could be tacked on after.
 
Upvote 1
Solution

Forum statistics

Threads
1,215,093
Messages
6,123,067
Members
449,090
Latest member
fragment

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