Hello louvaek,
Try these macros and let me know how they perform.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Area As Range
Dim H As Range
Dim r As Long
Dim rng As Range
Dim U As Range
Dim WF As Object
If Intersect(Target, Range("c:c")) Is Nothing Then Exit Sub
Set rng = Range("c9:i19,c22:i27,c30:i41,c44:i78,c81:i91,c94:i110,c113:i118,c121:i126,c129:i151,c154:i16,c165:i169,c172:i175,c178:i180")
For Each Area In rng.Areas
Area.Sort Key1:=Area, Order1:=xlAscending, Header:=xlNo, MatchCase:=False, OrderCustom1:=1, Orientation:=xlLeftToRight
Next Area
Application.EnableEvents = False
Application.ScreenUpdating = False
Set WF = WorksheetFunction
Set H = ActiveWorkbook.ActiveSheet.Rows.Find("*", , , , xlByRows, xlPrevious).Offset(5)
Set U = H
For r = ActiveWorkbook.ActiveSheet.Rows.Find("*", , , , xlByRows, xlPrevious).Row + 5 To 12 Step -1
If WF.CountA(Range(Cells(r - 1, 1), Cells(r, 8))) = 0 Then
Set H = Union(H, Cells(r, 1))
ElseIf WF.CountA(Range(Cells(r - 1, 1), Cells(r - 1, 8))) <> 0 Then
Set U = Union(U, Cells(r, 1), Cells(r - 1))
End If
Next r
H.EntireRow.Hidden = True
U.EntireRow.Hidden = False
Application.EnableEvents = True:
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range
Dim rng As Range
Set rng = Range("A1:Z250")
If Intersect(Target, rng) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each cell In rng
If Not cell.Comment Is Nothing Then
With cell.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next cell
Application.ScreenUpdating = True
End Sub
Bookmarks