Place values of user chosen cells into array

[Reset]

I need to place a group of values form cells chosen by the user in to an array. These could be discontinuous cells (mutitple choices by holding down the control key and clicking on cells). I have not got far...

a = Application.WorksheetFunction.CountA(Selection)
ReDim x(a) as Long

So now I have the count of number of highlighted cells and an array fitted to that size. How do I place the values of selected cells into the array?

 

[tweedle]

See if this makes sense

Sub SelectionToArray()
    Dim arr()
    Dim Cell As Range
    'Redim array to number of cells selected
    ReDim arr(Selection.Cells.Count - 1)
    'Create a tracker to tell where you are in the array
    ArrIdx = LBound(arr)
    'Cycle through the cells and add their values to the array
    For Each Cell In Selection
        arr(ArrIdx) = Cell.Value
        ArrIdx = ArrIdx + 1
    Next
    'Output the array to a messagebox
    Msg = ""
    For ArrIdx = LBound(arr) To UBound(arr)
        Msg = Msg & arr(ArrIdx) & vbLf
    Next
    MsgBox Msg, vbOKOnly, "Contents of Array"
End Sub

 

[Reset]

Awesome!

 

[tweedle]

Here's another version

[COLOR=blue]'In a new Module
[/COLOR]Public Type SelectionCellInfo
    cellWSheet As String
    cellAddress As String
    cellValue As Variant
    cellText As String
End Type
Sub SelectionToArrayVerbose()
    Dim arr() As SelectionCellInfo
    Dim Cell As Range
    'Redim array to number of cells selected
    ReDim arr(Selection.Cells.Count - 1)
    'Create a tracker to tell where you are in the array
    ArrIdx = LBound(arr)
    'Cycle through the cells and add their values to the array
    For Each Cell In Selection
        arr(ArrIdx).cellWSheet = Cell.Worksheet.Name
        arr(ArrIdx).cellAddress = Cell.AddressLocal
        arr(ArrIdx).cellValue = Cell.value
        arr(ArrIdx).cellText = Cell.text
        ArrIdx = ArrIdx + 1
    Next
    'Output the array to a messagebox
    Msg = ""
    For ArrIdx = LBound(arr) To UBound(arr)
        Msg = Msg & arr(ArrIdx).cellWSheet & "!" & _
        arr(ArrIdx).cellAddress & _
        " V: " & arr(ArrIdx).cellValue & _
        " T: " & arr(ArrIdx).cellText & vbLf
    Next
    MsgBox Msg, vbOKOnly, "Contents of Array"
End Sub