Morning,

I nice question and hopely some people to help me :)

I've got a sheet with columns A till BZ and thousands of records.
Some people had remarked (manually fill patterncolor) some of the cells with a color (all different colors).
I need to know which rows have a colormarked cell.

The sheet is also build up with old/new datarecords. Those records are always combined with eachother based on the UniqueCode in column E.

In column A I like to get the number 1 (for selection) for the row if in the row in range column F till BZ one of the cells have a color (other then the normal standard blank). If in the row in column F till BZ none of the cells is colored then it gives the number 0.

Next challange...
Now you get rows with in column A the number 1 (some cells colored) and 0 (none of the cells colored).
If in column E de UniqueCode is the same and one of the rows with the same UniquCode has a 1 as result of the macro, then the result in A for the rows with a 0 must be overruled with a 1.

Start Situation
A E F till BZ
... UniqueCode1 (no colored cells)
... UniqueCode2 (no colored cells)
... UniqueCode2 (no colored cells)
... UniqueCode2 (one or more colored cells)

First step (cells with a color results in 1)
A E F till BZ
0 UniqueCode1 (no colored cells)
0 UniqueCode2 (no colored cells)
0 UniqueCode2 (no colored cells)
1 UniqueCode2 (one or more colored cells)

Next step (if UniqueCode is the same and one of the rows has 1 then all are 1)
A E F till BZ
0 UniqueCode1 (no colored cells)
1 UniqueCode2 (no colored cells)
1 UniqueCode2 (no colored cells)
1 UniqueCode2 (one or more colored cells)

Should be (very) nice if somebody can help me out.
Nice to have a solution for the normal manual selection.

regards, Johan

Hi Johan,

Am Wed, 3 Jul 2019 23:02:39 -0700 (PDT) schrieb JS SL:

Start Situation
A E F till BZ
.. UniqueCode1 (no colored cells)
.. UniqueCode2 (no colored cells)
.. UniqueCode2 (no colored cells)
.. UniqueCode2 (one or more colored cells)

First step (cells with a color results in 1)
A E F till BZ
0 UniqueCode1 (no colored cells)
0 UniqueCode2 (no colored cells)
0 UniqueCode2 (no colored cells)
1 UniqueCode2 (one or more colored cells)

Next step (if UniqueCode is the same and one of the rows has 1 then all are 1)
A E F till BZ
0 UniqueCode1 (no colored cells)
1 UniqueCode2 (no colored cells)
1 UniqueCode2 (no colored cells)
1 UniqueCode2 (one or more colored cells)

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
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016

Thanks (as usual),

Works as wished !!. Allways amazing how you can fix a problem :)

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.

regards, Johan

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

Hi again,

Am Sat, 6 Jul 2019 15:46:09 +0200 schrieb Claus Busch:

For Each rngC In .Range("B3:BZ3")
If rngC.Interior.ColorIndex = xlNone Then rngC.EntireColumn.Hidden = True
Next

sorry typo.
Change the first line to

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


Regards
Claus B.
--
Windows10
Office 2016

Claus, Thanks (!).

After run the macro all the columns F till BZ are hidden :)
But... There are only a few cells in the range 'F3 till BZ last row' with a collored cell. The macro hides them all.

Only the columns without any colored cell in one of the rows of that specific column should be set on hide (hide if at least one of the cells in all the used rows has a fill color).

Can you please have a look on it.
The part with the numbers wordks perfect !

regards, Johan.

----------------------------------------------------------------------------


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("F3:BZ3")
If rngC.Interior.ColorIndex = xlNone Then rngC.EntireColumn.Hidden = True
Next
End With
End Sub