Thread: How to Paste Macro in VBA & Remove Need for KB Shortcut

Hi

I have VBA assigned to a command button. I have created a Macro to sort this data and assigned it to a keyboard shortcut. I have pasted the macro code into the VBA but need it to run without the keyboard short i.e. when the command button, which is already linked to VBA, is pressed.

Here's the code :

Private Sub cmdAwards_Click()

Dim Index As Integer
Dim NextStudent As String
Dim LastCell As String

Index = 3
NextStudent = Worksheets!StudentDataSheet.Cells(Index, 1)

Do While Left(NextStudent, 1) = "C"
Worksheets!DegreeAwards.Cells(Index - 1, 2) = Worksheets!StudentDataSheet.Cells(Index, 1)
Worksheets!DegreeAwards.Cells(Index - 1, 3) = Worksheets!StudentDataSheet.Cells(Index, 6) & "," & _
                                              Worksheets!StudentDataSheet.Cells(Index, 7)
Worksheets!DegreeAwards.Cells(Index - 1, 4) = Worksheets!StudentDataSheet.Cells(Index, 2)
Worksheets!DegreeAwards.Cells(Index - 1, 5) = Worksheets!StudentDataSheet.Cells(Index, 45)
Worksheets!DegreeAwards.Cells(Index - 1, 6) = Worksheets!StudentDataSheet.Cells(Index, 58)
Worksheets!DegreeAwards.Cells(Index - 1, 7) = CInt((Worksheets!StudentDataSheet.Cells(Index, 45) _
+ _
Worksheets!StudentDataSheet.Cells(Index, 58)) _
\ 2)

If Worksheets!DegreeAwards.Cells(Index - 1, 7) > 69 Then
Worksheets!DegreeAwards.Cells(Index - 1, 8) = "1st"
ElseIf Worksheets!DegreeAwards.Cells(Index - 1, 7) > 59 Then
Worksheets!DegreeAwards.Cells(Index - 1, 8) = "2:1"
ElseIf Worksheets!DegreeAwards.Cells(Index - 1, 7) > 49 Then
Worksheets!DegreeAwards.Cells(Index - 1, 8) = "2:2"
Else
Worksheets!DegreeAwards.Cells(Index - 1, 8) = "3rd"
End If
Index = Index + 1
NextStudent = Worksheets!StudentDataSheet.Cells(Index, 1)
Loop

End Sub

Sub DegreeSort()
'
' DegreeSort Macro
' Sort degree by levels 1st class to 3rd
'
' Keyboard Shortcut: Ctrl+Shift+H
'
    ActiveWorkbook.Worksheets("DegreeAwards").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DegreeAwards").Sort.SortFields.Add Key:=Range( _
        "H2:H11"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "1st,2:1,2:2,3rd", DataOption:=xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("DegreeAwards").Sort.SortFields.Add Key:=Range( _
        "C2:C11"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("DegreeAwards").Sort
        .SetRange Range("B2:H11")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Thanks for the welcome and solution!