entire sheet fill detect

[MR3]

i am looking to select an entire worksheet and determine whether or not any of the cells have an Interior Color other than the default of "No Fill"

 

[S M C]

Sub ColorCells()
    
    If IsNull(ActiveSheet.UsedRange.Interior.ColorIndex) Then
        MsgBox "Active sheet as colored cells"
    ElseIf ActiveSheet.UsedRange.Interior.ColorIndex <> -4142 Then
        MsgBox "Active sheet as colored cells"
    End If
    
End Sub

 

[ISY]

Hallo

Title: Delete the Custom Formats Not Used
Author : L Longre, mpfe
Comment: custom sizes, fano growing volume of files, so it is useful to clean it sometime. - This macro then deletes all formats personnalizzati unused folder

- The macro also removes the formatting is not used and also the cells that are attached to the empty cells

You need to add the project reference "Microsoft Forms 2.0 Object Library".
'=======================

Sub SopprFormatNonUsati() 
SupprFormats True 
End Sub  

Sub SopprFormatCelleVuote() 
SupprFormats False 
End Sub  

Private Sub SupprFormats(Min As Boolean)  

Dim Form As String, Prev As String, F As Str  in g 
Dim I As Integer, J As Integer  
Dim dObj As New DataObject, C As New Collect io n  
Dim Wksht As Worksheet, Cell As Range, Shts As  Sheet s 

Application.EnableCancelKey =  xlDisabled 
Application.StatusBar = "Lista i  formati... " 
Do 
J  = (J + 1) Mod 5 
If J = 0 Then I = I + 1  
Application.SendKeys "{TAB}{END}{TAB 2}{HO ME }"  & I If(I, "{PGDN " _ 
& I & "}", "")  & IIf(J, "{DOWN " & J & " }" , "") & "+{TAB}^c{ESC}"  
Application.Dialogs(xlDialogFormatNumber). Sh ow  
dObj.GetFromClipboard 
Form = dObj.GetText(1) 
If Form =  Prev Then Exit Do 
C.Add Form, Form  
Prev = Form 
Loop  
Application.StatusBar = "Search of the formats being..." 
Set Shts = ActiveWindow.SelectedSheets  
On Error Resume Next 
For Each Wksht In Worksheets 
Wksht.Select 
For Each Cell In  Wksht.UsedRange 
If Not IsEmpty(Cell) Or Min Then  
F = C.Item(Cell.NumberFormatLocal)  
If F <> "" Then 
C.Remove Cell.NumberFormatLocal 
F =  "" 
End If 
End If  
Next Cell 
Next  Wksht 
Application.ScreenUpdating = False  
Err.Clear 
Application.StatusBar = False 
J = 0  
With ActiveWorkbook 
Workbooks.Add 
For I = 1 To C.Count  
Range("A1").NumberFormatLocal = C(I)  
.DeleteNumberFormat ActiveCell.NumberFor ma t  
If Err = 0 Then J = J + 1 Else Err.Clear  
Next I 
MsgBox J  & " The formats used are not suppressed. ", vbInformation 
End With 
ActiveWorkbook.Close False  
Shts.Select 

End Sub

Code to enter on a Module

 

[MR3]

appending to my original post. if the Interior Fill Color is detected then insert Column A and fill it with any color thus allowing filtering for rows with a fill color or without a fill color

 

[Greg Truby]

@ ISY - perhaps you meant to post this information on a different thread? It does not appear to be relevant to the question being asked on this particular thread. You may want to check and see if there was a different thread you were involved with where you meant to send this response.

@ ndcruz - yes, if you can show us the code that you have written in an attempt to do this, we can take a look at it and see what you might need to fix.

 

[S M C]

Option Explicit

Sub ColorCells()
    
    Dim objRow As Object
    Dim lngInserted As Boolean
    
    For Each objRow In ActiveSheet.UsedRange.Rows
        If IsNull(objRow.Interior.ColorIndex) Then
            If Cells(objRow.Row, 1).Interior.Color <> vbBlue Then
                lngInserted = True
                objRow.Cells(1).Insert xlToRight
                Cells(objRow.Row, 1).Interior.Color = vbBlue
            End If
        ElseIf objRow.Interior.ColorIndex <> -4142 Then
            If Cells(objRow.Row, 1).Interior.Color <> vbBlue Then
                lngInserted = True
                objRow.Cells(1).Insert xlToRight
                Cells(objRow.Row, 1).Interior.Color = vbBlue
            End If
        Else
            If Cells(objRow.Row, 1).Interior.Color = vbBlue Then
                Cells(objRow.Row, 1).Interior.Color = xlNone
            Else
                If lngInserted Then
                    objRow.Cells(1).Insert xlToRight
                End If
            End If
        End If
    Next objRow
    
End Sub

 

[MR3]

pretty close SMC... but here is the error

before:


after:


you can see the data Shifts to the right, once the first fill is detected.

 

[MR3]

still pondering a solution cause of the data shift as shown in the pictures

 

[Peter_SSs]

Since S M C doesn't appear to have been back yet, I've tried this modification to the suggested code. Is this what you want?

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> ColorCells()<br>    <SPAN style="color:#00007F">Dim</SPAN> objRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> aColorCells<br>    <SPAN style="color:#00007F">Dim</SPAN> x<br>    <br>    <SPAN style="color:#00007F">With</SPAN> ActiveSheet.UsedRange<br>        x = .Interior.Color<SPAN style="color:#00007F">In</SPAN>dex<br>        <SPAN style="color:#00007F">If</SPAN> IsNull(x) <SPAN style="color:#00007F">Or</SPAN> x <> -4142 <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">ReDim</SPAN> aColorCells(.Row <SPAN style="color:#00007F">To</SPAN> .Row + .Rows.Count - 1, 1 <SPAN style="color:#00007F">To</SPAN> 1)<br>            <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> objRow In ActiveSheet.UsedRange.Rows<br>                <SPAN style="color:#00007F">If</SPAN> objRow.Interior.ColorIndex = -4142 <SPAN style="color:#00007F">Then</SPAN><br>                    aColorCells(objRow.Row, 1) = 1<br>                <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>            <SPAN style="color:#00007F">Next</SPAN> objRow<br>            Columns("A").Insert<br>            <SPAN style="color:#00007F">With</SPAN> Intersect(.EntireRow, Columns("A"))<br>                .Value = aColorCells<br>                .SpecialCells(xlCellTypeBlanks).Interior.Color = vbBlue<br>                .ClearContents<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[MR3]

Thanks Peter!! your code is exactly what i was looking for