Make code faster with IF THEN function

[Jones1413]

Hello,

I have the following code to sort through three different columns. If Column 5 is empty, it needs to be filled in with the specified color. However, there are times that column 5 may not be empty. When there are no empty cells in column 5, it turns all three columns(5,6,7) all blue. How can I prevent this from happening? Also, this code seems to take forever to run. Is there anyway to make it faster? The number of rows of data changes every time I pull this specific report so I put a large number(2500) to read to the bottom. This slows the Macro down, can it be made to where it finds the last row of data so the code will run faster?

Sub Jones1413()

Dim lastRowFilled
lastRowFilled = 2500
For iCntr = lastRowFilled To 1 Step -1
If Rows(iCntr).Hidden = True Then Rows(iCntr).EntireRow.Delete
Next

Dim Usdrws As Long

With ActiveSheet
Usdrws = Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:K" & Usdrws).AutoFilter 5, ""
.AutoFilter.Range.Offset(1).Columns(5).Resize(Usdrws - 1).Interior.Color = 16776960
.Range("A1:K" & Usdrws).AutoFilter 5
.Range("A1:K" & Usdrws).AutoFilter 5, ""
.Range("A1:K" & Usdrws).AutoFilter 6, ""
.Range("A1:K" & Usdrws).AutoFilter 7, ""
.AutoFilter.Range.Offset(1).Columns(6).Resize(Usdrws - 1).Interior.Color = 16776960
.AutoFilter.Range.Offset(1).Columns(7).Resize(Usdrws - 1).Interior.Color = 16776960
.Range("A1:K" & Usdrws).AutoFilter 7
.Range("A1:K" & Usdrws).AutoFilter 6
.Range("A1:K" & Usdrws).AutoFilter 5
.Range("A1:K" & Usdrws).AutoFilter 5, "Internal"
.Range("A1:K" & Usdrws).AutoFilter 6, ""
.AutoFilter.Range.Offset(1).Columns(6).Resize(Usdrws - 1).Interior.Color = 16776960
.Range("A1:K" & Usdrws).AutoFilter 6
.Range("A1:K" & Usdrws).AutoFilter 5
.Range("A1:K" & Usdrws).AutoFilter 5, Array("Conversion", "Referral", "Temp-to-hire", "Well"), xlFilterValues
.Range("A1:K" & Usdrws).AutoFilter 7, ""
.AutoFilter.Range.Offset(1).Columns(7).Resize(Usdrws - 1).Interior.Color = 16776960
.Range("A1:K" & Usdrws).AutoFilter 5
.Range("A1:K" & Usdrws).AutoFilter 7


End With


End Sub

 

[Fluff]

How about

Sub Jones1413()
   Dim UsdRws As Long, i As Long
   Dim Rng As Range

   With ActiveSheet
      UsdRws = Range("A" & Rows.Count).End(xlUp).Row
      For i = 2 To UsdRws
         If .Rows(i).Hidden Then
            If Rng Is Nothing Then Set Rng = .Rows(i) Else Set Rng = Union(Rng, .Rows(i))
         End If
      Next i
      If Not Rng Is Nothing Then Rng.Delete
      .Range("A1:K" & UsdRws).AutoFilter 5, ""
      .Range("E1:E" & UsdRws).SpecialCells(xlVisible).Interior.Color = 16776960
      .Range("A1:K" & UsdRws).AutoFilter 6, ""
      .Range("A1:K" & UsdRws).AutoFilter 7, ""
      .Range("F1:G" & UsdRws).SpecialCells(xlVisible).Interior.Color = 16776960
      .Range("A1:K" & UsdRws).AutoFilter 7
      .Range("A1:K" & UsdRws).AutoFilter 5, "Internal"
      .Range("A1:K" & UsdRws).AutoFilter 6, ""
      .Range("F1:F" & UsdRws).SpecialCells(xlVisible).Interior.Color = 16776960
      .Range("A1:K" & UsdRws).AutoFilter 6
      .Range("A1:K" & UsdRws).AutoFilter 5, Array("Conversion", "Referral", "Temp-to-hire", "Well"), xlFilterValues
      .Range("A1:K" & UsdRws).AutoFilter 7, ""
      .Range("G1:G" & UsdRws).SpecialCells(xlVisible).Interior.Color = 16776960
      .ShowAllData
      .Range("E1:G1").Interior.Color = xlNone
   End With
End Sub

 

[DanteAmor]

How about. We add a row after the last row to the Rng and then save an If inside the For.

Sub Jones1413()
   Dim UsdRws As Long, i As Long
   Dim Rng As Range


   With ActiveSheet
      UsdRws = Range("A" & Rows.Count).End(xlUp).Row
[COLOR=#0000ff]      Set Rng = .Rows(UsdRws + 1)[/COLOR]
      For i = 2 To UsdRws
[COLOR=#008000]         If .Rows(i).Hidden Then[/COLOR]
[COLOR=#008000]            Set Rng = Union(Rng, .Rows(i))[/COLOR]
[COLOR=#008000]         End If[/COLOR]
      Next i
       Rng.Delete '[COLOR=#008000]Sure there is a row.[/COLOR]
      .Range("A1:K" & UsdRws).AutoFilter 5, ""
      .Range("E1:E" & UsdRws).SpecialCells(xlVisible).Interior.Color = 16776960
      .Range("A1:K" & UsdRws).AutoFilter 6, ""
      .Range("A1:K" & UsdRws).AutoFilter 7, ""
      .Range("F1:G" & UsdRws).SpecialCells(xlVisible).Interior.Color = 16776960
      .Range("A1:K" & UsdRws).AutoFilter 7
      .Range("A1:K" & UsdRws).AutoFilter 5, "Internal"
      .Range("A1:K" & UsdRws).AutoFilter 6, ""
      .Range("F1:F" & UsdRws).SpecialCells(xlVisible).Interior.Color = 16776960
      .Range("A1:K" & UsdRws).AutoFilter 6
      .Range("A1:K" & UsdRws).AutoFilter 5, Array("Conversion", "Referral", "Temp-to-hire", "Well"), xlFilterValues
      .Range("A1:K" & UsdRws).AutoFilter 7, ""
      .Range("G1:G" & UsdRws).SpecialCells(xlVisible).Interior.Color = 16776960
      .ShowAllData
      .Range("E1:G1").Interior.Color = xlNone
   End With
End Sub