using vba to automatically sort a table

J

jbrown021286

Board Regular
Joined
Mar 13, 2023
Messages
97
Office Version
  1. 365
Platform
  1. Windows
Dispatch Sheet vba test 3.xlsm
ABCDEFGHIJK
1Promise TimeJobTimeTagTechA-FG-BufferShorting helperColumn1SearchRamy
212:00 PMdiag1356011:00 AM10:30 AM0Weeks Hours
31:00 PMdiag3517710:00 AM9:30 AM0
4recall1.48892  20
5brakes1.78891  2RO. Count
6recalls15178  2
7diag16550  20
8diag1.55170  2Total Hours
9diag11531  2
10diag12950  20
11diag18897  2
12recalls0.58894123  2Time
13diag1295324  211:00:32 AM
1460 k2.888901  2
15diag151695  2SearchRamy
16  2Weeks Hours
17  2
Dash Board
Cell Formulas
RangeFormula
K1,K15K1='data grouping'!$F$2
F2:F17F2=IF(OR(ISBLANK([@[Promise Time]]), ISBLANK([@Time])), "", [@[Promise Time]]-[@Time]/24)
G2:G17G2=IF(OR([@[A-F]]="",'data grouping'!$AG$2=""),"",[@[A-F]]-'data grouping'!$AG$2)
H2:H17H2=IF(AND(A2<>"", D2<>""), IF(E2<>"", 1, 0), 2)
K4K4='data grouping'!$F$5
K7K7='data grouping'!G5
K10K10='data grouping'!$F$7
K13K13=MOD(NOW(),1)
Cells with Conditional Formatting
CellConditionCell FormatStop If True
J2,D2:D86Cell ValueduplicatestextNO
D2:D86Cell ValueduplicatestextNO
J16Cell ValueduplicatestextNO
K10:AA10Other TypeColor scaleNO
K7:AA7Other TypeColor scaleNO
A2:I86Expression=$E2<>""textNO
A2:I86Expression=$G2<$K$13textNO

i am looking to automatically sort this table in a 3 step process whenever a new line of data is added. the 1st step is based off of Column A and needs to have Red cells on top. The 2nd step is based off of column H and needs to be Sorted Smallest to Largest. and the 3rd step is based off of column A and need to be sorted smallest to largest. i need the sorting to automatically run i 2 separate scenarios. 1. when a new line of data is added in all A, B, C, D columns and 2 when something is entered in column E. i figure the only way to achieve something so complicated is through using a vba but i am not versed enough in them to no where to start. any help would be greatly appreciated. not sure if it makes a difference but i currently have 2 vba running on this sheet. 1. to start the vba when the workbook is open and 2. to recalculate the sheet every 1 seconds to constantly update the time in cell K13
 
Sort by date Sort by votes
Paste the following into the Sheet level Module of the sheet to be sorted :

VBA Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long
    Dim allDataEntered As Boolean
    Dim i As Integer

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    ' Find the last row with data in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Check if the change occurred in Columns A to D
    If Not Intersect(Target, ws.Columns("A:D")) Is Nothing Then
        ' Check if all cells in Columns A:D of the same row as the change have data
        allDataEntered = True
        For i = 1 To 4
            If ws.Cells(Target.Row, i).Value = "" Then
                allDataEntered = False
                Exit For
            End If
        Next i

        ' Proceed only if all cells in Columns A:D have data
        If allDataEntered Then
            ' Sort Column A (smallest to largest)
            Set rng = ws.Range("A1:J" & lastRow)
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=ws.Range("A2:A" & lastRow), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With

            ' Sort by color (red cells at the top) in Column A
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add(ws.Range("A2:A" & lastRow), _
                                xlSortOnCellColor, xlAscending, , _
                                xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With

            ' Sort by Column H (smallest to largest)
            Set rng = ws.Range("A1:J" & lastRow)
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=ws.Range("H2:H" & lastRow), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
        End If
    End If

    ' Check if the change occurred in Column E and the new value is not empty
    If Not Intersect(Target, ws.Columns("E")) Is Nothing Then
        If Target.Value <> "" Then
            ' Sort Column A (smallest to largest)
            Set rng = ws.Range("A1:J" & lastRow)
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=ws.Range("A2:A" & lastRow), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With

            ' Sort by color (red cells at the top) in Column A
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add(ws.Range("A2:A" & lastRow), _
                                xlSortOnCellColor, xlAscending, , _
                                xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With

            ' Sort by Column H (smallest to largest)
            Set rng = ws.Range("A1:J" & lastRow)
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=ws.Range("H2:H" & lastRow), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
        End If
    End If
End Sub

As indicated the macro auto runs if data is entered into all cell A:D . The macro also auto runs if data is entered into Column E.

If data exists in Column E but is subsequentially deleted / removed, the previous sort is unaffected.
 
Upvote 0
Solution
Logit said:
Paste the following into the Sheet level Module of the sheet to be sorted :

VBA Code: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long
    Dim allDataEntered As Boolean
    Dim i As Integer

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

    ' Find the last row with data in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Check if the change occurred in Columns A to D
    If Not Intersect(Target, ws.Columns("A:D")) Is Nothing Then
        ' Check if all cells in Columns A:D of the same row as the change have data
        allDataEntered = True
        For i = 1 To 4
            If ws.Cells(Target.Row, i).Value = "" Then
                allDataEntered = False
                Exit For
            End If
        Next i

        ' Proceed only if all cells in Columns A:D have data
        If allDataEntered Then
            ' Sort Column A (smallest to largest)
            Set rng = ws.Range("A1:J" & lastRow)
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=ws.Range("A2:A" & lastRow), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With

            ' Sort by color (red cells at the top) in Column A
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add(ws.Range("A2:A" & lastRow), _
                                xlSortOnCellColor, xlAscending, , _
                                xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With

            ' Sort by Column H (smallest to largest)
            Set rng = ws.Range("A1:J" & lastRow)
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=ws.Range("H2:H" & lastRow), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
        End If
    End If

    ' Check if the change occurred in Column E and the new value is not empty
    If Not Intersect(Target, ws.Columns("E")) Is Nothing Then
        If Target.Value <> "" Then
            ' Sort Column A (smallest to largest)
            Set rng = ws.Range("A1:J" & lastRow)
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=ws.Range("A2:A" & lastRow), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With

            ' Sort by color (red cells at the top) in Column A
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add(ws.Range("A2:A" & lastRow), _
                                xlSortOnCellColor, xlAscending, , _
                                xlSortNormal).SortOnValue.Color = RGB(255, 0, 0)
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With

            ' Sort by Column H (smallest to largest)
            Set rng = ws.Range("A1:J" & lastRow)
            With ws.Sort
                .SortFields.Clear
                .SortFields.Add Key:=ws.Range("H2:H" & lastRow), _
                                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SetRange rng
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .Apply
            End With
        End If
    End If
End Sub

As indicated the macro auto runs if data is entered into all cell A:D . The macro also auto runs if data is entered into Column E.

If data exists in Column E but is subsequentially deleted / removed, the previous sort is unaffected.
Click to expand...
1737317232248.png

1737317309952.png

when i put it in the tryed to test it these errors popped up. not sure what i did wrong
 
Upvote 0
Code: 
Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name

Change "Sheet1" to the name of your worksheet.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
conditional formatting not working with "now" formula
Replies
1
Views
140
arthurbr
arthurbr
Z
  • Question Question
Sum and Total from Large Data Set
Replies
1
Views
133
etaf
etaf
M
  • Solved
VBA generate copy of another sheet, then find and replace links
Replies
5
Views
187
MeaclH
M
A
  • Question Question
Evaluate cell or have cell refer to itself after being transposed via. lookup functions
Replies
2
Views
195
Sam_D_Ben
Sam_D_Ben
JenniferMurphy
  • Solved
How to calculate rank (subrank?) in NFL conference and division?
Replies
6
Views
268
JenniferMurphy
JenniferMurphy

Share this page

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