Auto alphabetize individual columns

[Adlcv99]

Hi. I am trying to figure out how to sort each column individually in alphabetical order if and when a new country name is added to that column. Picture attached of example data.
I have only been able to create a VBA to sort one column if a new country name is added but if will do nothing to the others just move them around based on the current sort. I cannout figure out how to get the other columns to sort as well individually when a new country name is added.

 

[Adlcv99]

 

[Logit]

.
See if this works for your needs. Untested here :

Sub SortMultipleColumns()

    With Worksheets("Sheet1")
        with .cells(1, "A").currentregion
            .Cells.Sort Key1:=.Range("A1"), Order1:=xlAscending, _
                        Key2:=.Range("B1"), Order2:=xlAscending, _
                        Key3:=.Range("C1"), Order3:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
        end with
    End With

End Sub

 

[Adlcv99]

Hi. Thanks but I couldn't get it to work. It would only sort the first column only after I had to make it run manually. Maybe I just am doing something wrong.

 

[Logit]

.
I didn't want to make the macro this large but couldn't get it to work otherwise.

Paste this in a REGULAR MODULE :

Option Explicit

Sub SortMultipleColumns()

Application.ScreenUpdating = False

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:A50")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlAscending
        .Apply
    End With
    
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B1:B50")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlAscending
        .Apply
    End With
    
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("C1:C508")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlAscending
        .Apply
    End With
    
Application.ScreenUpdating = True
End Sub

Download link: Sort Columns.xlsm

 

[Dossfm0q]

Greetings
Try this

Sub test()
Sort Range("A1:E10") ' change A1:E10 as your request
'Call Sort(Range("A1:E10"))  ' change A1:E10 as your request
End Sub

Sub Sort(DataRng As Range)

'''''''''''''''' Note  without Header''''''''''''
Dim CLCnt As Long, RwCnt As Long
Dim SrtRng As Range

CLCnt = DataRng.Columns.Count 'Number of Columns
RwCnt = DataRng.Rows.Count    'Number of Rows

    For Cl = 1 To CLCnt 'to go through Range Columns On By on

    Set SrtRng = DataRng.Cells(1, Cl).Resize(RwCnt, 1) ' Sort Range column by column
        SrtRng.Sort Key1:=SrtRng.Cells(1, 1), Order1:=xlAscending, Header:=xlNo

    Next

End Sub

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("A:C")) Is Nothing Then
      Target.EntireColumn.Sort key1:=Cells(1, Target.Column), order1:=xlAscending, Header:=xlYes
   End If
End Sub

This needs to go in the relevant sheet module and assumes you are looking at columns A,B & C.

 

[Adlcv99]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("A:C")) Is Nothing Then
      Target.EntireColumn.Sort key1:=Cells(1, Target.Column), order1:=xlAscending, Header:=xlYes
   End If
End Sub

This needs to go in the relevant sheet module and assumes you are looking at columns A,B & C.

Thank you this work!

 

[Adlcv99]

.
I didn't want to make the macro this large but couldn't get it to work otherwise.

Paste this in a REGULAR MODULE :

Option Explicit

Sub SortMultipleColumns()

Application.ScreenUpdating = False

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:A50")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlAscending
        .Apply
    End With
   
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B1:B50")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlAscending
        .Apply
    End With
   
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("C1:C508")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlAscending
        .Apply
    End With
   
Application.ScreenUpdating = True
End Sub

Download link: Sort Columns.xlsm

Thank you but this required the button to run and I was looking for an auto sort when a new country was added incase the people entering never hit the button.

 

[Fluff]

Glad we could help & thanks for the feedback.