CODEWITHSUNDEEP
excelvba
Michael Martin
Michael Martin

Reputation: 17

Highlighting Blank Cells within Range

I am working on a macro that copies, pastes, and then creates templates forms of various sizes. Before the macro saves the template sheet as a separate file, I have it searching through a range - typically through D14:G end of data range - and highlights blank cells in a custom color. However, I have one very specific use case where there are no blank cells within the range (D14:G16), so it has been selecting all blank cells below this range (A17 to end of sheet). Can anyone help me work past this? Below is the excerpt from the macro that highlights the blankcells:

 Set rLastCell = Sheets("Diversity Form").Cells.find(What:="*", After:=Sheets("Diversity Form").Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
        'ColumnLetter2 = Split(Cells(1, rLastCell.Column).Address, "$")(1)
        lCol = Sheets("Diversity Form").Cells(Rows.count, 4).End(xlUp).Row
        'Dim ColumnLetter As String
        'color only blank cells
        For h = 4 To 7
        ColumnLetter = Split(Cells(1, h).Address, "$")(1)
        Let item = ColumnLetter & "14:G" & lCol
        Sheets("Diversity Form").Range(item).SpecialCells(xlCellTypeBlanks).Select
        On Error Resume Next
            With Selection.Interior
               .Pattern = xlSolid
               .PatternColorIndex = xlAutomatic
               .ThemeColor = xlThemeColorAccent1
               .TintAndShade = 0.599993896298105
               .PatternTintAndShade = 0
            End With
    
        Next

Upvotes: 0

Views: 52

Answers (1)

BigBen
BigBen

Reputation: 50008

  • No need to loop here, or to mess with column letters, or to Select.
  • Use WorksheetFunction.CountBlank first to test if there are any blanks.
With Sheets("Diversity Form")
    Dim lastRow As Long
    lastRow = .Cells(.Rows.Count, 4).End(xlUp).Row

    Dim checkRange As Range
    Set checkRange = .Range(.Cells(14, 4), .Cells(lastRow, 7)) ' Or .Range("D14:G" & LastRow)
End With

If WorksheetFunction.CountBlank(checkRange) > 0 Then
    With checkRange.SpecialCells(xlCellTypeBlanks).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
End If

Upvotes: 2

Related Questions