Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Select the last cell in non-continuous Range

Tags:

excel

vba

with the below code, I need to select the last cell in non-continuous Range finalRange.
the expected result is cell S3 , But it is now N3

Sub Make_Selection1()
   
   Dim sh As Worksheet:  Set sh = ActiveSheet
   
   Dim finalRange As Range
   Set finalRange = sh.Range("A3:C3,E3:F3,H3,J3,L3,N3:S3")

   Dim rng As Range, r As Long
    For Each rng In finalRange.Areas
        r = r + rng.Columns.Count
    Next rng
    
   finalRange.Cells(1, r).Select
   
End Sub
like image 982
Peace Avatar asked Sep 17 '25 12:09

Peace


2 Answers

You can use this generic function - it will work for any multi-column, multi-row range and any order of indiviudal ranges.

Function getLastCell(rg As Range, Optional fSelectNonEmptyCell As Boolean = True) As Range

Dim c As Range, a As Range, maxColumn As Long, maxRow As Long
For Each a In rg.Areas
    For Each c In a.Cells
        If (fSelectNonEmptyCell = True And LenB(c.Value) > 0) Or _
            fSelectNonEmptyCell = False Then
            If c.Column > maxColumn Then maxColumn = c.Column
            If c.Row > maxRow Then maxRow = c.Row
        End If
    Next
Next

If maxRow > 0 And maxColumn > 0 Then
    Set getLastCell = rg.Parent.Cells(maxRow, maxColumn)
Else
    If fSelectNonEmptyCell = True Then
        Err.Raise vbObjectError + 512, , "No non-empty cell found in " & rg.Address(, , , external:=True)
    Else
        Err.Raise vbObjectError + 512, , "No cell found in " & rg.Address(, , , external:=True)
    End If
End If
End Function

Use it like this:

Sub Make_Selection1()
   
   Dim sh As Worksheet:  Set sh = ActiveSheet
   
   Dim finalRange As Range
   Set finalRange = sh.Range("A3:C3,E3:F3,H3,J3,L3,N3:S3")
   
   getLastCell(finalRange).Select
   
End Sub
like image 66
Ike Avatar answered Sep 19 '25 07:09

Ike


The result should not depend on the order of the fields as defined in the String, but on the position in the Sheet.

Sub Make_Selection1()
   Dim lastArea As Range, maxcol As Long, tmp As Long, sh As Worksheet:  Set sh = ActiveSheet

   Dim finalRange As Range, rng As Range, r As Long
   Set finalRange = sh.Range("N3:S3,A3:C3,E3:F3,H3,J3,L3")

   For Each rng In finalRange.Areas
      tmp = rng.Column + rng.Columns.CountLarge - 1
      If tmp > maxcol Then
         Set lastArea = rng
         maxcol = tmp
      End If
   Next
   lastArea.Cells(lastArea.rows.CountLarge, lastArea.Columns.CountLarge).Select
End Sub
like image 27
ΑΓΡΙΑ ΠΕΣΤΡΟΦΑ Avatar answered Sep 19 '25 07:09

ΑΓΡΙΑ ΠΕΣΤΡΟΦΑ