In the end I have 15 ranges that this will be applied to. This is a snip of the code as it's redundant really. This is what I currently have and just wondering if there is a cleaner way with a for loop to do this.

Sub Select_Cells()
Dim rg1 As Range, rg2 As Range, rg3 As Range
If [B7] > "" Then Set rg1 = [A1] Else Set rg1 = Nothing
If [B8] > "" Then Set rg2 = [B2] Else Set rg2 = Nothing
If [B9] > "" Then Set rg3 = [C3] Else Set rg3 = Nothing
union(rg1, rg2, rg3).Select
End Sub

What I was hoping to do was something like this (yes I know the construction is wrong):

rg1 = "[A1]": rg2 = "[B2]": rg3 = "[C3]"
r = 7
For x = 1 To 15
If Range("B" & r) > "" Then Set rg(x) = rg(x) Else Set rg(x) = Nothing
r=r 1
Next x
union(rg1, rg2, rg3).Select

Any help would be most appreciative.

CodePudding user response：

Combine Cells Into a Range

• This will check if cell B7 in Sheet2. If it is not blank, it will combine cell A1 in Sheet1 into a range union(durg). Then it will do the same for the cell below B7 which is cell B8 in Sheet2, and the cell below and to the right of cell A1 which is cell B2 in the worksheet Sheet1. It will do this 15 times altogether (another 13 times) ending with B21 in Sheet2 and O15 in Sheet1. Finally, it will select the combined cells (in Sheet1).

Option Explicit

Sub RefDiagonalUnionTEST()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Column
    Dim cws As Worksheet: Set cws = wb.Worksheets("Sheet2")
    Dim cfCell As Range: Set cfCell = cws.Range("B7")
    
    ' Diagonal
    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1")
    Dim dfCell As Range: Set dfCell = dws.Range("A1")
    
    ' Diagonal Union of Column Non-Blanks
    Dim durg As Range: Set durg = RefDiagonalUnion(cfCell, dfCell, 15)
    
    If durg Is Nothing Then
        MsgBox "No non-blank cells found.", vbCritical
        Exit Sub
    End If
    
    wb.Activate
    dws.Select
    durg.Select

    MsgBox "The selected cells are" & vbLf & durg.Address(0, 0), vbInformation
    
End Sub

Function RefDiagonalUnion( _
    ByVal ColumnFirstCell As Range, _
    ByVal DiagonalFirstCell As Range, _
    ByVal rgSize As Long) _
As Range
    
    Dim cfCell As Range: Set cfCell = ColumnFirstCell
    Dim dfCell As Range: Set dfCell = DiagonalFirstCell
    
    Dim durg As Range
    Dim n As Long
    
    Do
        If Len(CStr(cfCell.Value)) > 0 Then
            If durg Is Nothing Then
                Set durg = dfCell
            Else
                Set durg = Union(durg, dfCell)
            End If
        End If
        Set cfCell = cfCell.Offset(1)
        Set dfCell = dfCell.Offset(1, 1)
        n = n   1
    Loop Until n = rgSize
    
    If durg Is Nothing Then Exit Function
    
    Set RefDiagonalUnion = durg
    
End Function

CodePudding user response：

Firstly, to be able to effectively use looping, you need to determine regularities between the objects you're going to process.

Based on the snippets you provided, I assumed those regularities are:

• The If cells are adjacent to each other in vertical direction;
• The cells being selected are adjacent in diagonal direction and their row numbers equal to their column numbers (Cells(i, i)).

Secondly, you don't need any arrays for your task (rg(x) in your code is an array, I assume). You can just use a Union object (which is a Range) and update it each time If condition is met.

Dim sel As Range
Dim i As Integer
Dim r As Integer
r = 7
For i = 1 To 15
  If Range("B" & r).Value > "" Then
    If sel Is Nothing Then
      Set sel = Cells(i, i)
    Else
      Set sel = Union(sel, Cells(i, i))
    End If
  End If
  r = r   1
Next i
sel.Select