Sort with VBA

[urimagic]

Hi friends,

Please may I be helped with a code that will do the following: If I type a name in column A, and the age in column B, As soon as column B is released, I would like the columns A and B to sort according to column B, ascending order. This must work for all consecutive pairs of columns, so anything in column C, then the age in column D, release column D then all info sort in columns C and D, according to D, ascending order. All and any help will be greatly appreciated. Thank you kindly.

Sort.xlsx
	A	B	C	D	E	F
1	Pete	15
2	Sandra	12
3	John	18
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sheet1

 

[ranman256]

put this code into Workbook events area by:
in spreadsheet, enter VBE via: Alt-F11
in left pane (projects side) dbl-click the ThisWorkbook object
in right pane (code side), paste the code.

when user edits cells in Col 2,4 or 6, the data will sort

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Select Case Target.Column
   Case 2
     SortBlock "A", "B"
 
   Case 4
     SortBlock "C", "D"
 
   Case 6
     SortBlock "E", "F"
End Select

End Sub

private Sub SortBlock(ByVal psCol1, ByVal psCol2)
Dim iLastRow As Integer
Dim ws As Worksheet
Set ws = ActiveSheet


Columns(psCol1 & ":" & psCol2).Select
iLastRow = ActiveSheet.UsedRange.Rows.Count

With ws
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=Range(psCol2 & "1:" & psCol2 & iLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add2 Key:=Range(psCol1 & "1:" & psCol1 & iLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range(psCol1 & "1:" & psCol2 & iLastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  
End With
Range("A1").Select
End Sub

 

[urimagic]

put this code into Workbook events area by:
in spreadsheet, enter VBE via: Alt-F11
in left pane (projects side) dbl-click the ThisWorkbook object
in right pane (code side), paste the code.

when user edits cells in Col 2,4 or 6, the data will sort

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Select Case Target.Column
   Case 2
     SortBlock "A", "B"
 
   Case 4
     SortBlock "C", "D"
 
   Case 6
     SortBlock "E", "F"
End Select

End Sub

private Sub SortBlock(ByVal psCol1, ByVal psCol2)
Dim iLastRow As Integer
Dim ws As Worksheet
Set ws = ActiveSheet


Columns(psCol1 & ":" & psCol2).Select
iLastRow = ActiveSheet.UsedRange.Rows.Count

With ws
    .Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:=Range(psCol2 & "1:" & psCol2 & iLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add2 Key:=Range(psCol1 & "1:" & psCol1 & iLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
        .SetRange Range(psCol1 & "1:" & psCol2 & iLastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
End With
Range("A1").Select
End Sub

Hi ranman256,

an error occurs..

Just a few things...the code must work right through to column Z at least...also I forgot something else, I have installed Excel 2013, I did update my profile..sorry about that..also, row 1 has headers..I forgot to include them...then a last thing...I posted this question a few years ago and got response...it was a rather small code, and worked just great..the thing is I wiped my pc because of a crash and lost that file, I also am unable to find my posts of yester year to get the code again...I checked here and on Excel help forum.....nothing...
Ok, anycase, the code you gave gives an error...I suppose it's because of the excel version I had wrong on my profile?

 

[MARK858]

Try the code below in a copy of your worksheet. Code goes in the worksheet module... right click the sheet tab, click view code and paste the code in the window that appears

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myRng As Range
    
    If Target.CountLarge > 1 Then Exit Sub
    
    If Target.Column Mod 2 = 0 Then
        If Target.Offset(, -1) <> "" Then
    
            Application.EnableEvents = False
            Set myRng = Cells(1, Target.Column).Offset(, -1).Resize(, 2).EntireColumn
            myRng.Sort myRng.Cells(1, 2), 1, , , , , , 1
            Application.EnableEvents = True
    
        End If
    End If
End Sub

 

[urimagic]

Try the code below in a copy of your worksheet. Code goes in the worksheet module... right click the sheet tab, click view code and paste the code in the window that appears

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myRng As Range
   
    If Target.CountLarge > 1 Then Exit Sub
   
    If Target.Column Mod 2 = 0 Then
        If Target.Offset(, -1) <> "" Then
   
            Application.EnableEvents = False
            Set myRng = Cells(1, Target.Column).Offset(, -1).Resize(, 2).EntireColumn
            myRng.Sort myRng.Cells(1, 2), 1, , , , , , 1
            Application.EnableEvents = True
   
        End If
    End If
End Sub

Hi MARK858,

this works perfectly!!..I am most grateful, thank you!

 

[MARK858]

You're welcome