How can we find multiple used range addresses in one sheet?-CodePudding

How can we loop through all cells in a sheet and find multiple used range addresses on this one sheet? In this screen shot we have used ranges of B2:F17, I2:M17, Q2:U17, C19:M34, and Q19:U34. How can I identify these beginning and ending cell addresses of these five used ranges, and print them in an array of cells? I have some sample code that shows the total used range on a sheet.

Sub Vba_Used_Range()

Dim iCell As Range
Dim iRange As Range
Dim c As Long
Dim i As Long

Set iRange = ActiveSheet.UsedRange

For Each iCell In ActiveSheet.UsedRange
    c = c   1
    If IsEmpty(iCell) = True Then
        i = i   1
    End If
Next iCell

MsgBox "There are total " & c & _
" cell(s) in the range, and out of those " & _
i & " cell(s) are empty."

End Sub

Again, how can I print cell addresses for multiple used ranges on one sheet?

CodePudding user response：

    Dim rArea As Range
    For Each rArea In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants xlCellTypeFormulas).Areas
        Debug.Print rArea.Address
    Next rArea

CodePudding user response：

Empty Cells in Worksheet Regions

Inspired by userMT.
It is assumed that the regions contain values, not formulas.

Option Explicit


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the number of cells and the number of empty cells
'               of the worksheet regions containing values in a message box.
' Calls:        RefWorksheetValueRegions,CountEmptyCells.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Vba_Used_Range()

    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim uarg As Range: Set uarg = RefWorksheetValueRegions(ws)
    If uarg Is Nothing Then Exit Sub
    
    Dim ecCount As Long: ecCount = CountEmptyCells(uarg)
    
    MsgBox "There is a total of " & uarg.Cells.Count & _
        " cell(s) in the range, and out of those " & _
        ecCount & " cell(s) are empty."

End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the worksheet regions containing values.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefWorksheetValueRegions( _
    ByVal ws As Worksheet) _
As Range
    Const ProcName As String = "RefWorksheetValueRegions"
    On Error GoTo ClearError

    Dim turg As Range
    Dim curg As Range
    Dim arg As Range
    
    For Each arg In ws.UsedRange.SpecialCells(xlCellTypeConstants).Areas
'        Debug.Print "Area:       " & arg.Address
        If turg Is Nothing Then
            Set curg = arg.CurrentRegion
            Set turg = curg
        Else
            If Intersect(arg, curg) Is Nothing Then
                Set curg = arg.CurrentRegion
                Set turg = Union(turg, curg)
            End If
        End If
    Next arg
            
    If turg Is Nothing Then Exit Function
    
'    For Each arg In turg.Areas
'        Debug.Print "Total Area: " & arg.Address
'    Next arg
            
    Set RefWorksheetValueRegions = turg
            
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the number of empty cells of a range.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CountEmptyCells( _
    ByVal mrg As Range) _
As Long
    Const ProcName As String = "CountEmptyCells"
    On Error GoTo ClearError
    
    Dim arg As Range
    Dim ecCount As Long
    
    For Each arg In mrg.Areas
        On Error Resume Next
            ecCount = ecCount   arg.SpecialCells(xlCellTypeBlanks).Count
        On Error GoTo ClearError
    Next arg
    
    CountEmptyCells = ecCount

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function