CODEWITHSUNDEEP
vbaexcel
Greenberet
Greenberet

Reputation: 500

Get CurrentRegion only in vertical direction

I would like to write a UDF (user defined function, aka. macro) that will be used in each of the green cells. In this function/macro in want to get the length of the longest string in the framed cells next to my current group of green cells. In order to do this in the macro I need to determine a range that represents all of the framed cells next to the current cell. (This calculation should result the same range object for each cell in one green group but a different one from group to group.) How would you get this Range?

enter image description here

My first try was this:

Range(Application.Caller.Offset(0, -1).End(xlUp),_
      Application.Caller.Offset(0, -1).End(xlDown))

But this

I would need something like ActiveCell.Offset(0, -1).CurrentRegion, but in the vertical direction only.

Upvotes: 0

Views: 2053

Answers (3)

Scott Craner
Scott Craner

Reputation: 152585

Try this:

Function findlongest()

Dim fullcolumn() As Variant
Dim lastrow As Long
Dim i As Long, j As Long, k As Long
Dim tmax As Long
tmax = 0
With Application.Caller
    lastrow = .Parent.Cells(.Parent.Rows.Count, .Column - 1).End(xlUp).Row
    fullcolumn = .Parent.Range(.Parent.Cells(1, .Column - 1), .Parent.Cells(lastrow, .Column - 1)).Value
    For j = .Row To 1 Step -1
        If fullcolumn(j, 1) = "" Then
            j = j + 1
            Exit For
        ElseIf j = 1 Then
            Exit For
        End If
    Next j
    For i = .Row To UBound(fullcolumn, 1)
        If fullcolumn(i, 1) = "" Then
            i = i - 1
            Exit For
        ElseIf i = UBound(fullcolumn, 1) Then
            Exit For
        End If
    Next i

    'to get the range
    Dim rng As Range
    Set rng = .Parent.Range(.Parent.Cells(j, .Column - 1), Parent.Cells(i, .Column - 1))
    'then do what you want with rng


    'but since you already have the values in an array use that instead.
    'It is quciker to iterate and array than the range.
    For k = j To i
        If Len(fullcolumn(k, 1)) > tmax Then tmax = Len(fullcolumn(k, 1))
    Next k
findlongest = tmax
End With
End Function

enter image description here

Upvotes: 1

Dy.Lee
Dy.Lee

Reputation: 7567

This is an example of setting each range using Area.

Sub test()
    Dim Ws As Worksheet
    Dim rngDB As Range
    Dim rngA As Range, rng As Range

    Set Ws = ActiveSheet
    With Ws
        Set rngDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp))

        Set rngA = rngDB.SpecialCells(xlCellTypeConstants, xlTextValues)
        For Each rng In rngA.Areas
            rng.Offset(, 1).Select '<~~ select is not required but is intended to be visualized
        Next rng
    End With
End Sub

enter image description here

Upvotes: 0

Shai Rado
Shai Rado

Reputation: 33692

Are you after something like the code below:

Option Explicit

Sub GetLeftRange()

Dim myRng As Range

Set myRng = ActiveCell.Offset(, -1).CurrentRegion

Debug.Print myRng.Address

End Sub

Note: ActiveCell is one of the cells you marked as green.

Upvotes: 0

Related Questions