vba select only cells with value in range-CodePudding

I want to select only cells that contains data in specific range (C7:I15). Code below can do that only for column "G". How to change code for my range?

Sub Testa()
Dim LR As Long, cell As Range, rng As Range
With Sheets("Sheet1")
    LR = .Range("G" & Rows.Count).End(xlUp).Row
    For Each cell In .Range("G2:G" & LR)
        If cell.Value <> "" Then
            If rng Is Nothing Then
                Set rng = cell
            Else
                Set rng = Union(rng, cell)
            End If
        End If
    Next cell
    rng.Select
End With
End Sub

CodePudding user response：

You can use a generic function to which you pass the range that should be checked - and which returns a range with the non-empty cells (see update below for function using SpecialCells instead of iteration)

Public Function rgCellsWithContent(rgToCheck As Range) As Range
Dim cell As Range

For Each cell In rgToCheck
    If cell.Value <> "" Then
        If rgCellsWithContent Is Nothing Then
            Set rgCellsWithContent = cell
        Else
            Set rgCellsWithContent = Union(rgCellsWithContent, cell)
        End If
    End If
Next cell

End Function

You can use this sub like this:

Sub Testa()

With ThisWorkbook.Worksheets("Sheet1")

    'select cells in range C7:I15
    rgCellsWithContent(.Range("C7:I15")).Select

    'select cells in column G
    Dim LR As Long
    LR = .Range("G" & Rows.Count).End(xlUp).Row
    rgCellsWithContent(.Range("G2:G" & LR)).Select
    
    'you can even combine both
    Dim rgNew As Range
    Set rgNew = rgCellsWithContent(.Range("C7:I15"))
    Set rgNew = Union(rgNew, rgCellsWithContent(.Range("G2:G" & LR)))
    
    rgNew.Select
End With

End Sub

UPDATE:

This function uses the SpecialCells command.

You can make a difference to return values only or to return values and formulas.

Public Function rgCellsWithContent(rgToCheck As Range, _
    Optional fValuesAndFormulas As Boolean = True) As Range
    
Dim cell As Range

On Error Resume Next 'in case there are no cells

With rgToCheck
    Set rgCellsWithContent = .SpecialCells(xlCellTypeConstants)
    
    If fValuesAndFormulas Then
        Set rgCellsWithContent = Union(rgCellsWithContent, .SpecialCells(xlCellTypeFormulas))
    End If
End With

On Error GoTo 0
        
End Function

CodePudding user response：

If no formulas in the range where selection should be done, you can use the next compact code, not needing any iteration:

    Dim rng As Range
    On Error Resume Next 'for the case of no any empty cell
     Set rng = Range("C7:I15").SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    If Not rng Is Nothing Then rng.Select

The next version is able to deal with formulas, too:

    Dim rng As Range, rngSel As Range, arrFormula
    Set rng = Range("C7:I15")
    With rng
        arrFormula = .Formula
        .Value = .Value
        On Error Resume Next
         Set rngSel = .SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        .Formula = arrFormula
    End With
    If Not rngSel Is Nothing Then rngSel.Select