Convert 2d arrays to 1D arrays

[davrosg]

Hi all,
I'm reading in two columns in Sheet3 as follows...

  Dim aryAA As Variant, aryBB As Variant
  
  aryAA = Sheets(3).Range("A2:A" & Sheets(3).Cells(Rows.Count, 1).End(3).Row).Value
  aryBB = Sheets(3).Range("B2:B" & Sheets(3).Cells(Rows.Count, 2).End(3).Row).Value

Is there a quick way of converting these to 1D arrays ("x","y","z",.....) or reading in the columns as two 1D arrays in the first place?

Thanks!

 

[mikerickson]

Perhaps this will help you

myArray = Range("A1:A10").Value ' is a 2-D array (1 to 10, 1 to 1)

myArray = Application.Transpose(Range("A1:A10").Value) ' is a 1-D array (1 to 10)

myArray = Range("A1:J1").Value ' is a 2-D array (1 to 1, 1 to 10)

myArray = Application.Transpose(Application.Transpose(Range("A1:J1").Value)) ' is a 1-D array (1 to 10)

So for your code

With Sheets(3).Range("A2:A" & Sheets(3).Cells(Rows.Count, 1).End(3).Row)
    aryAA = Application.Transpose(.Value)
End With
With Sheets(3).Range("B2:B" & Sheets(3).Cells(Rows.Count, 2).End(3).Row)
    aryBB = Application.Transpose(.Value)
End With

If you want a single 1-D array with elements from both columns A and B, you would have to loop.

 

[mikerickson]

Note that the Transpose approach only works if there are less than 4*Columns.Count elements in the final 1-D array.

 

[Rick Rothstein]

Perhaps this will help you

myArray = Range("A1:J1").Value ' is a 2-D array (1 to 1, 1 to 10)

myArray = Application.Transpose(Application.Transpose(Range("A1:J1").Value)) ' is a 1-D array (1 to 10)

You can also write the 1D array assignment this way...

myArray = Application.Index(Range("A1:J1").Value, 1, 0)

 

[Rick Rothstein]

You can also write the 1D array assignment this way...

myArray = Application.Index(Range("A1:J1").Value, 1, 0)

I should have emphasized... the above method only works for a horizontal row of values, use what Mike posted for a vertical column of values.

 

[davrosg]

Thanks everyone, that's awesome.

 

[Kenneth Hobson]

Nice and simple examples Mike and Rick.

Davrosg, I would recommend finding the last row in column A or in the usedrange rather than in both columns A and B. That is unless you wanted possibly more elements in one array than the other.

FWIW: This routine can be played from a blank sheets(1) to test how it is used. I often need to delete blanks and sort in various ways with both numbers and text in the array. This lets the numbers or text be listed 1st or 2nd.

Sub Main()
  Dim c As Range, r As Range, aryAA()
  
  With Sheets(1)
    For Each c In .[A1:B10]
      c.Value = c.Address
    Next c
    
    .[a2] = ""  'Add a blank cell.
    .[A3] = 3   'Add some numbers.
    .[A4] = 2
    Set r = .Range("A2:B" & .Cells(Rows.Count, "A").End(xlUp).Row)
  End With
    
  aryAA = advArrayListSort(r, False)  'No sort.
  MsgBox Join(aryAA, vbLf)
  
  'Sort descending. Text is the 2nd in this case.
  aryAA = advArrayListSort(r, , , False)
  MsgBox Join(aryAA, vbLf)
End Sub

'https://msdn.microsoft.com/en-us/library/system.collections.arraylist(v=vs.110).aspx
Function advArrayListSort(sn As Variant, _
  Optional tfSort As Boolean = True, _
  Optional tfAscending1 As Boolean = True, _
  Optional tfAscending2 As Boolean = True, _
  Optional tfNumbersFirst As Boolean = True, _
  Optional tfDelBlanks As Boolean = True) As Variant
  
  Dim i As Long, c1 As Object, c2 As Object
  Dim a1() As Variant, a2() As Variant, a() As Variant
  Dim v As Variant
  
  Set c1 = CreateObject("System.Collections.ArrayList")
  Set c2 = CreateObject("System.Collections.ArrayList")
  
  For Each v In sn
    If IsNumeric(v) = True Then
      c1.Add v
      ElseIf tfDelBlanks And v <> "" Then c2.Add v
      ElseIf tfDelBlanks = False Then c2.Add v
    End If
  Next v
  
  On Error Resume Next  'If no number or text, errors would occur.
  If tfSort Then
    c1.Sort 'Sort ascendending
    c2.Sort 'Sort ascending
    
    If tfAscending1 = False Then c1.Reverse 'Sort and then Reverse to sort descending
    If tfAscending2 = False Then c2.Reverse 'Sort and then Reverse to sort descending
  End If
  
  a1() = c1.Toarray()
  a2() = c2.Toarray()
  
  If tfNumbersFirst = True Then
    a() = a1()
    For i = 1 To c2.Count
      ReDim Preserve a(UBound(a) + 1)
      a(UBound(a)) = a2(i - 1)
    Next i
    Else
    a() = a2()
    For i = 1 To c1.Count
      ReDim Preserve a(UBound(a) + 1)
      a(UBound(a)) = a1(i - 1)
    Next i
  End If
  
  advArrayListSort = a()
End Function