none
reading a range into vba array RRS feed

  • Question

  • Hi everyone,

    I need a vba code to get a range into  array. The trick is that I want vba to go through entire column, i.e. B:B and put generate an array out of range containing only NOT empty cells.

    Let's say I got values in cells B5:B20, and then B40:B50. I'd like vba to find those and assign into an array. 

    The point is that not empty cells will be different from time to time, so I cannot code a constant array.

    I would extremely appreciate your help.

    regards,

    Dawid

    Monday, May 27, 2013 9:49 AM

Answers

  • Try this;

    Sub EnterArray()
    Dim MyArray() As Variant
    Dim MyColumn As Range
    Dim cell As Range
    Dim i As Long
    
    i = 0
    ' set the column to read, e.g. B
    Set MyColumn = ActiveSheet.Range("B:B")
    
    For Each cell In Intersect(ActiveSheet.UsedRange, MyColumn)
      If Not IsEmpty(cell) Then
        ReDim Preserve MyArray(i)
        MyArray(i) = cell.Value
        i = i + 1
      End If
    Next
    
    
    ' now show array values in column D
    For i = LBound(MyArray) To UBound(MyArray)
      ActiveSheet.[D1].Offset(i, 0) = MyArray(i)
    Next
    
    End Sub

    Ed Ferrero 

    www.edferrero.com


    • Marked as answer by dawid_m Monday, May 27, 2013 11:04 AM
    • Edited by Ed Ferrero Tuesday, May 28, 2013 3:59 AM put code in code block
    Monday, May 27, 2013 10:24 AM

All replies

  • Try this;

    Sub EnterArray()
    Dim MyArray() As Variant
    Dim MyColumn As Range
    Dim cell As Range
    Dim i As Long
    
    i = 0
    ' set the column to read, e.g. B
    Set MyColumn = ActiveSheet.Range("B:B")
    
    For Each cell In Intersect(ActiveSheet.UsedRange, MyColumn)
      If Not IsEmpty(cell) Then
        ReDim Preserve MyArray(i)
        MyArray(i) = cell.Value
        i = i + 1
      End If
    Next
    
    
    ' now show array values in column D
    For i = LBound(MyArray) To UBound(MyArray)
      ActiveSheet.[D1].Offset(i, 0) = MyArray(i)
    Next
    
    End Sub

    Ed Ferrero 

    www.edferrero.com


    • Marked as answer by dawid_m Monday, May 27, 2013 11:04 AM
    • Edited by Ed Ferrero Tuesday, May 28, 2013 3:59 AM put code in code block
    Monday, May 27, 2013 10:24 AM
  • great! thank you!
    Monday, May 27, 2013 11:04 AM