modify a macro to have startCol and endCol

DeezNuts

Board Regular
Joined
Aug 12, 2014
Messages
177
I currently have a macro that works for columns 1:5
Code:
Sub SortAreas()
    Dim i As Long, j As Long, startRow As Long, areaRows As Long, areaCols As Long, sortKeyCol As Long, sortAscending As Boolean
    Dim a, s As Long
    startRow = 6
    areaCols = 5
    areaRows = 3
    sortKeyCol = 4
    If MsgBox("Do you want to sort grades ascending or descending?" & vbCrLf & vbCrLf & "Click [Yes] for ascending" & vbCrLf & "Click [No] for descending", vbYesNo, "Sort by?") = vbYes Then
        sortAscending = True
    Else
        sortAscending = False
    End If
    
    Application.ScreenUpdating = False
    With ActiveSheet
        For i = startRow To .Cells(.Rows.Count, sortKeyCol).End(xlUp).Row Step areaRows + 1
            s = 0
            a = .Cells(i, 1).Resize(areaRows, areaCols).Value
            For j = i + areaRows + 1 To .Cells(.Rows.Count, sortKeyCol).End(xlUp).Row Step areaRows + 1
                If s = 0 Then
                    If sortAscending Then If .Cells(j, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value < a(1, sortKeyCol) Then s = j
                    If Not sortAscending Then If .Cells(j, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value > a(1, sortKeyCol) Then s = j
                Else
                    If sortAscending Then If .Cells(j, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value < .Cells(s, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value Then s = j
                    If Not sortAscending Then If .Cells(j, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value > .Cells(s, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value Then s = j
                End If
            Next
            If s > 0 Then
                .Cells(i, 1).Resize(areaRows, areaCols).Value = .Cells(s, 1).Resize(areaRows, areaCols).Value
                .Cells(s, 1).Resize(areaRows, areaCols).Value = a
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

I would like to know how would I make the script work with columns 7:11 with 10 being the sortKeyCol. Here is what I tried

Code:
Sub SortTest()
    Dim i As Long, j As Long, startCol As Long, endCol As Long, startRow As Long, areaRows As Long, startCol As Long, endCol As Long, areaCols As Long, sortKeyCol As Long, sortAscendingTest As Boolean
    Dim a, s As Long
    startCol = 7
    endCol = 11
    startRow = 6
    areaCols = 5
    areaRows = 3
    sortKeyCol = 10
    If MsgBox("Do you want to sort grades ascending or descending?" & vbCrLf & vbCrLf & "Click [Yes] for ascending" & vbCrLf & "Click [No] for descending", vbYesNo, "Sort by?") = vbYes Then
        sortAscendingTest = True
    Else
        sortAscendingTest = False
    End If
    
    Application.ScreenUpdating = False
    With ActiveSheet
        For i = startRow To .Cells(.Rows.Count, sortKeyCol).End(xlUp).Row Step areaRows + 1
            s = 0
            a = .Cells(i, 1).Resize(areaRows, areaCols).Value
            For j = i + areaRows + 1 To .Cells(.Rows.Count, sortKeyCol).End(xlUp).Row Step areaRows + 1
                If s = 0 Then
                    If sortAscendingTest Then If .Cells(j, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value < a(1, sortKeyCol) Then s = j
                    If Not sortAscendingTest Then If .Cells(j, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value > a(1, sortKeyCol) Then s = j
                Else
                    If sortAscendingTest Then If .Cells(j, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value < .Cells(s, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value Then s = j
                    If Not sortAscendingTest Then If .Cells(j, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value > .Cells(s, 1).Resize(areaRows, areaCols)(1, sortKeyCol).Value Then s = j
                End If
            Next
            If s > 0 Then
                .Cells(i, 1).Resize(areaRows, areaCols).Value = .Cells(s, 1).Resize(areaRows, areaCols).Value
                .Cells(s, 1).Resize(areaRows, areaCols).Value = a
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Not sure what I need to change in the code itself to prevent getting a run-time 9 error and make it work. Could someone lend a hand with this please.
 

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)
Not sure

I think


a = .Cells(i, 1).Resize(areaRows, areaCols).Value

needs to become

a = .Cells(i, 7).Resize(areaRows, areaCols).Value

and all others
</pre>
 
Upvote 0
Thank you for trying mole but that didnt do it. Hopefully different time of day new eyes on this will help
 
Upvote 0
Could someone who has a second to look at this let me know if this can be done simply by editing or does another script need to be wrote.
 
Upvote 0

Forum statistics

Threads
1,224,269
Messages
6,177,564
Members
452,784
Latest member
talippo

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