Hi Johan,

Am Thu, 4 Jul 2019 21:46:10 -0700 (PDT) schrieb

JS SL:

It taste to a bit more (if you like).

The next step step is to hide the columns in the range F till BZ if in the rows 3 (not 2 but 3) till last of that column is no colored cell.

After this rule I have a quick view on only the colored rows with the unique rownrs, but also only the columns that have a marked cell.

Makes life easier.
try:

Sub Test()

Dim myRow As Range, rngC As Range, myRng As Range

Dim i As Integer, myCnt As Integer, Counter As Integer

Dim LRow As Long

With ActiveSheet

LRow = .Cells(.Rows.Count, "E").End(xlUp).Row

For Each myRow In .Range("F1:BZ" & LRow).Rows

Counter = 0

For i = .Columns("F").Column To .Columns("BZ").Column

If .Cells(myRow.Row, i).Interior.ColorIndex < xlNone Then

.Cells(myRow.Row, 1) = 1

Exit For

Else

Counter = Counter + 1

End If

Next

If Counter = 73 Then .Cells(myRow.Row, 1) = 0

Next

For i = 1 To LRow

myCnt = Application.CountIf(.Range("E1:E" & LRow), .Cells(i, "E"))

If myCnt 1 Then

Set myRng = .Cells(i, 1).Resize(myCnt)

myRng.Select

If Application.CountIf(myRng, 1) 0 Then

myRng = 1

i = i + myCnt - 1

End If

End If

Next

For Each rngC In .Range("B3:BZ3")

If rngC.Interior.ColorIndex = xlNone Then rngC.EntireColumn.Hidden = True

Next

End With

End Sub

Regards

Claus B.

--

Windows10

Office 2016