Home > other >  Selecting multiple ranges subject to a criteria
Selecting multiple ranges subject to a criteria

Time:11-19

Is it possible to select multiple ranges subject to each range meeting a set criteria?

For example, if I have 12 ranges in excel, I only want to select the range to be included if the range contains data

If range 1 & 3 have data and range 2 does not have data i want to select Range(1,3) excluding range 2

Can this be done with vba code for excel

CodePudding user response:

You can accomplish this with the Union function.

This code would go through a range of cells shown in the Range parameter and then select only those that are not empty.

Sub selectSomes()

Dim aCell As Range, zRange As Range

For Each aCell In Range("A5:J5").Cells
    If Not IsEmpty(aCell) Then
        If zRange Is Nothing Then
            Set zRange = aCell
        Else
            Set zRange = Union(zRange, aCell)
        End If
    End If
Next aCell

zRange.Select

End Sub

CodePudding user response:

Select Non-Blank Ranges

  • If at least one cell is not blank, the range will be 'added'.
Option Explicit

Sub SelectNonBlankRanges()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1") ' adjust
    Dim rg As Range
    Set rg = Union(ws.Range("Zone1"), ws.Range("Zone2"), ws.Range("Zone3"), _
        ws.Range("Zone4"), ws.Range("Zone5"), ws.Range("Zone6"), _
        ws.Range("Zone7"), ws.Range("Zone8"), ws.Range("Zone9"), _
        ws.Range("Zone10"), ws.Range("Zone11"), ws.Range("Zone12"))
     
    Dim prg As Range
    Dim arg As Range
    
    ' Combine the non-blank ranges into a multi-range.
    For Each arg In rg.Areas
        'Debug.Print arg.Address, Application.CountBlank(arg), arg.Cells.Count
        If Application.CountBlank(arg) < arg.Cells.Count Then
            If prg Is Nothing Then
                Set prg = arg
            Else
                Set prg = Union(prg, arg)
            End If
        End If
    Next arg
    
    If prg Is Nothing Then Exit Sub
    
    ws.Activate
    prg.Select
    
    MsgBox "Range '" & prg.Address(0, 0) & "' selected.", vbInformation
    
End Sub
  • Related