Create an array of the location of all the cells in the first column of a selection in VBA-CodePudding

I would like to create an array that has the actual cell locations of the first column of a selection. For example if I've selected cells E26:I31, I would like to produce an array with the following: ar = Array("E26", "E27", "E28", "E29", "E30", "E31"). I imagine there may be a quick way to do this but I haven't quite figured it out yet. Thanks! Here is an example of the array that would work for my code vs what using columns(1) would store:

CodePudding user response：

In order to do this you need to use the ReDim statement. Try this:

    Dim selected As Range
    Dim myArray As Variant
    
    Set selected = Selection.Columns(1)
    ReDim myArray(selected.Rows.Count)

    Dim i As Integer
    For i = 1 To selected.Rows.Count
        myArray(i) = selected.Cells(i).Address
    Next i

CodePudding user response：

Cell Addresses in an Array

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Writes the cell addresses of the first column
'               (of the first area) of a range to an array.
' Calls:        ArrFirstColumnAddresses
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ArrFirstColumnAddressesTEST()
    
    If Not TypeOf Selection Is Range Then
        MsgBox "The selection is not a range.", vbCritical
        Exit Sub
    End If
        
    Dim sArr() As String: sArr = ArrFirstColumnAddresses(Selection)
    
    ' Do something, e.g.:
    Debug.Print Join(sArr, " ") ' row
    Debug.Print Join(sArr, vbLf) ' column
    Debug.Print "[LB=" & LBound(sArr) & ",UB=" & UBound(sArr) & "]"
        
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the cell addresses of the first column
'               (of the first area) of a range in an array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrFirstColumnAddresses( _
    ByVal SourceRange As Range) _
As String()
    Const ProcName As String = "ArrFirstColumnAddresses"
    Dim AnErrorHasOccurred As Boolean
    On Error GoTo ClearError
    
    Dim rg As Range: Set rg = SourceRange.Areas(1).Columns(1)
    
    Dim ColString As String: ColString = Split(rg.Cells(1).Address, "$")(1)
    
    Dim FirstRow As Long: FirstRow = rg.Row
    Dim rCount As Long: rCount = rg.Rows.Count
    
    Dim sArr() As String: ReDim sArr(0 To rCount - 1)
    
    Dim r As Long
    
    For r = FirstRow To FirstRow   rCount - 1
        sArr(r - FirstRow) = ColString & CStr(r)
    Next r
    
ProcExit:
    If AnErrorHasOccurred Then
        ArrFirstColumnAddresses = Split("")
    Else
        ArrFirstColumnAddresses = sArr
    End If
    
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    AnErrorHasOccurred = True
    Resume ProcExit
End Function