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

gravanoc

gravanoc

Active Member
Joined
Oct 20, 2015
Messages
351
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
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.
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
Maybe post the code you already have might help.
 
Upvote 0
Code: 
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.
 
Last edited:
Upvote 0
What do you call very slow....almost instant for me !!!


Code: 
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
 
Upvote 0
Try this.

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

Code: 
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
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

M
  • Solved
Deleting rows from a Range variable
Replies
4
Views
370
Umma123
U
J
  • Question Question
Formatting error when switching from Mac to PC
Replies
6
Views
121
RoryA
RoryA
W
  • Solved
Using MIN with IF resulting in #VALUE error
2
Replies
15
Views
1K
myall_blues
myall_blues
J
  • Solved
Using variable in Worksheets.Shapes.Range(Array("")).Select
Replies
4
Views
834
jlc19
J
Jeffrey Mahoney
  • Question Question
Named Range Lambda Formula to Create UDF
Replies
4
Views
247
Jeffrey Mahoney
Jeffrey Mahoney

Forum statistics

Threads
1,224,875
Messages
6,181,514
Members
453,050
Latest member
Obil

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top