How can I set a range variable that only includes cells in that range with data?

[gravanoc]

I have a very slow subroutine that uses a For Each statement to iterate through about 30 cells in a pre-defined range, checking if they have text in them, and then performing a bunch of formatting based on the text in that cell. I'm wondering if there is a faster way to do this that would quickly set a range variable to only include the cells that have data in them?

Thanks.

 

[Michael M]

Maybe post the code you already have might help.

 

[gravanoc]

Public Sub FormatCells()

    Dim rowCount As Long
    Dim i As Integer
    Dim c As Variant
    Dim fCell As Variant
    Dim jpSheet As Worksheet
    Dim str As String
    Dim borderRange As Range
    Dim jpRange As Range
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Set jpSheet = Worksheets("Job Planning")
    Set jpRange = jpSheet.Range("D3:D35")
    
    For Each rCell In jpRange
    
        If Len(rCell) < 2 Then GoTo NextIteration
    
        If Len(rCell.Address) = 5 Then
    
            str = Right(rCell.Address, 2)
    
        Else
    
            str = Right(rCell.Address, 1)
    
        End If
    
        Set borderRange = jpSheet.Range(rCell, rCell.Offset(0, 2))
    
            With rCell.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorLight2
                    .TintAndShade = 0.399975585192419
                    .PatternTintAndShade = 0
            End With
    
            With rCell.Offset(0, 1).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 10092543
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
    
            With rCell.Offset(0, 2).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent4
                    .TintAndShade = 0.399975585192419
                    .PatternTintAndShade = 0
            End With
    
            With rCell.Offset(0, 1).Font
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
            End With
    
        For Each c In borderRange
    
            With c.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
            End With
    
            With c.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
            End With
    
            With c.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
            End With
    
            With c.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
            End With
    
            With c.Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
            End With
    
            With c.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
            End With
    
        Next
    
            With borderRange.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
    
            With borderRange.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
    
        jpSheet.Shapes.Range(Array("CheckBox" & str)).Visible = msoTrue
    
NextIteration:
    
    Next
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True




End Sub

If it helps, I can upload the workbook to my Drive.

 

[Michael M]

What do you call very slow....almost instant for me !!!

Public Sub FormatCells()
    Dim rowCount As Long, i As Integer, c As Variant
    Dim rCell As Variant, jpSheet As Worksheet, str As String
    Dim borderRange As Range, jpRange As Range
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With
    Set jpSheet = Worksheets("Job Planning")
    Set jpRange = jpSheet.Range("D3:D35")
    For Each rCell In jpRange
        If Len(rCell) < 2 Then GoTo NextIteration
        If Len(rCell.Address) = 5 Then
            str = Right(rCell.Address, 2)
        Else
            str = Right(rCell.Address, 1)
        End If
        Set borderRange = jpSheet.Range(rCell, rCell.Offset(0, 2))
            With rCell.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorLight2
                    .TintAndShade = 0.399975585192419
                    .PatternTintAndShade = 0
            End With
            With rCell.Offset(0, 1).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 10092543
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            With rCell.Offset(0, 2).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent4
                    .TintAndShade = 0.399975585192419
                    .PatternTintAndShade = 0
            End With
            With rCell.Offset(0, 1).Font
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
            End With
        For Each c In borderRange
            With c.Borders
                    .LineStyle = xlContinuous
                    .ColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .Weight = xlThin
            End With
        Next c
            With borderRange.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
            With borderRange.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
        jpSheet.Shapes.Range(Array("CheckBox" & str)).Visible = msoTrue
NextIteration:
    Next rCell
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

 

[gravanoc]

I should add that I'm using the Camera command. It slows things down, but it has to stay. Here's my workbook: https://drive.google.com/open?id=1KGzr30xATU2KI9EopS8Gvfc-jPb07nZN

 

[DanteAmor]

Try this.

I put the cycle at the end to make checkboxes visible. A cycle is not required for the format

Public Sub FormatCells_2()
  Dim jpSheet As Worksheet, str As String, jpRange As Range, rCell As Range
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Set jpSheet = Worksheets("Job Planning")
  Set jpRange = jpSheet.Range("D3:D35").SpecialCells(xlCellTypeConstants)
  With jpRange.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorLight2
    .TintAndShade = 0.399975585192419
    .PatternTintAndShade = 0
  End With
  With jpRange.Offset(0, 1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 10092543
    .TintAndShade = 0
    .PatternTintAndShade = 0
  End With
  With jpRange.Offset(0, 2).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent4
    .TintAndShade = 0.399975585192419
    .PatternTintAndShade = 0
  End With
  With jpRange.Offset(0, 1).Font
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
  End With
  With jpRange.Borders
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThin
  End With
  With jpRange.Offset(0, 1).Borders
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThin
  End With
  With jpRange.Offset(0, 2).Borders
    .LineStyle = xlContinuous
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .Weight = xlThin
  End With
  For Each rCell In jpRange
    If Len(rCell.Address) = 5 Then
      str = Right(rCell.Address, 2)
    Else
      str = Right(rCell.Address, 1)
    End If
    jpSheet.Shapes.Range(Array("CheckBox" & str)).Visible = msoTrue
  Next
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

 

[gravanoc]

Thanks Dante, huge improvement!

 

[DanteAmor]

Im glad to help you, thanks for the feedback.