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
