Excel VBA speed up code to hide rows/delete color

[mrwad]

I am using following code to delete color and hide rows that include several criteria before exporting sheets to pdf's. Is there any way to speed up this process as it is taking quite a lot of time to process. Especially in situations when I have several sheets in one workbook and to apply this on each sheet = "printed page".

    Sub Color()
       Dim myRange As Range
       Dim cell As Range
       Application.ScreenUpdating = False
       Set myRange = ThisWorkbook.Sheets("Print version").Range("Print_Area")
           For Each cell In myRange
           myRange.Interior.ColorIndex = 0
           If cell.HasFormula = True And cell.Value = "" And cell.EntireRow.Hidden = False Then Rows(cell.Row).EntireRow.Hidden = True
       Next
       Application.ScreenUpdating = True
   End Sub

 

[charlesdh]

Hi,
Would it be possible to post a workbook?

Charles

 

[Hui]

Because you are setting the Interior colorindex to 0 why iterate through the cells

just use:

ThisWorkbook.Sheets("Print version").Range("Print_Area").Interior.ColorIndex = 0

Then in regards to hiding the entire row, is there 1 column that will have formulas, that way you can just step through the cells in 1 column, instead of the entire print area

Often people add a helper column labelled Print and it has values of True (Print) or False (Don't print)

then just step through that Column and reset the visibility of rows

You may be able to setup something similar

 

[Debaser]

It would be better to only process the necessary cells in each row and just do one hide operation at the end, like this:

Sub Color()
    Dim myRange As Range
    Dim cell As Range, rw As Range, hideRange As Range
    Application.ScreenUpdating = False
    Set myRange = ThisWorkbook.Sheets("Print version").Range("Print_Area")
    myRange.Interior.ColorIndex = 0
    For Each rw In myRange.Rows
        For Each cell In rw.Cells
            If cell.HasFormula Then
                If cell.Value = "" Then
                    If Not rw.Hidden Then
                        If hideRange Is Nothing Then
                            Set hideRange = rw
                        Else
                            Set hideRange = Union(hideRange, rw)
                        End If
                        Exit For    ' no need to process rest of the row
                    End If
                End If
            End If
        Next
    Next
    If Not hideRange Is Nothing Then hideRange.EntireRow.Hidden = True
    Application.ScreenUpdating = True
End Sub