Acelerar macro que da formato a un rango

Buenas tardes
Tengo el siguiente macro, que da formato a un rango variable el problema es cuando este se vuelve muy grande. Como hacer para que se ejecute más rapido. De antemano gracias.
Sub mensajes()
Set hoja = Worksheets("avance")
                hoja.Unprotect
                hoja.Range("d7:ds306").Validation.Delete
                hoja.Range("d7:ds306").FormatConditions.Delete
                total_col = hoja.Range("dv1")
                total_fil = hoja.Range("du1")
                Application.Calculation = xlManual
                For fil_1 = 7 To 7 + total_fil - 1
                    manzana = hoja.Cells(fil_1, 1).Value
                    etapa = hoja.Cells(fil_1, 2).Value
                    lote = hoja.Cells(fil_1, 3).Value
                    For col_1 = 4 To 4 + total_col - 1
                        concepto = hoja.Cells(5, col_1).Value
                        With hoja.Cells(fil_1, col_1)
                        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""a"""
                        .FormatConditions(1).Font.ColorIndex = 44
                        .FormatConditions(1).Interior.ColorIndex = 44
                        End With
                        With hoja.Cells(fil_1, col_1).Validation
                            .Delete
                            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator _
                            :=xlBetween, Formula1:="x"
                            .IgnoreBlank = True
                            .InCellDropdown = False
                            .InputTitle = ""
                            .ErrorTitle = "Error"
                            .InputMessage = concepto & Chr(10) & "mna - " & manzana & Chr(10) & "etapa - " & etapa & Chr(10) & "lote - " & lote
                            .ErrorMessage = "Solo marcar con ""x"" minuscula"
                            .ShowInput = True
                            .ShowError = True
                        End With
                    Next col_1
                Next fil_1
                Application.Calculation = xlAutomatic
                hoja.Protect
End Sub