Transfer multiple ranges to one array

[shum2934]

Hi,

I have a large table of data (from columns A to AU with about 7000 rows). I'd like to put the data from columns A, B, C, I and AU only in an array using a macro.

I've done a lot of searching and found how to put one range of data into an array, but not multiple ranges.

I understand I could do this by looping through thousands of lines of data, but surely there is a more efficient way than this!

This is my attempt but it keeps highlighting the '=' and saying "Expected: end of statement".

Sub datacheck()
Dim xarray(0 To 10000, 0 To 4) As Variant
 
Sheets("data").Activate
 
ReDim Preserve xarray(0 To Range("a50000").End(xlUp).Row - 4, 0) = _
range("a4", range("a50000").End(xlUp)).Value
 
End Sub

Any help would be greatly appreciated!

Sam

[I am using Excel 2010 on Windows XP]

 

[brettdj]

Sam,

You can work with the Range Areas of the Range with a basic For loop

This sample removes leading zeroes from a user selection in the active sheet "Using Variant Arrays in Excel VBA for Large Scale Data Manipulation", http://www.experts-exchange.com/A_2684.html

Note that it tests each RangeArea to see if it exceeds 1 cell before looking to use the array approach

Cheers

Dave

'Press Alt + F11 to open the Visual Basic Editor (VBE)
'From the Menu, choose Insert-Module.
'Paste the code into the right-hand code window.
'Press Alt + F11 to close the VBE
'In Xl2003 Goto Tools … Macro … Macros and double-click KillLeadingZeros

Sub KillLeadingZeros()
    Dim rng1 As Range
    Dim rngArea As Range
    Dim lngRow As Long
    Dim lngCol As Long
    Dim lngCalc As Long
    Dim objReg As Object
    Dim X()

  
    On Error Resume Next
    Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8)
    If rng1 Is Nothing Then Exit Sub
    On Error GoTo 0

    'See Patrick Matthews excellent article on using Regular Expressions with VBA
    Set objReg = CreateObject("vbscript.regexp")
    objReg.Pattern = "^0+"

   'Speed up the code by turning off screenupdating and setting calculation to manual
   'Disable any code events that may occur when writing to cells
    With Application
        lngCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    'Test each area in the user selected range
    
    'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
    For Each rngArea In rng1.Areas
        'The most common outcome is used for the True outcome to optimise code speed
        If rngArea.Cells.Count > 1 Then
           'If there is more than once cell then set the variant array to the dimensions of the range area
           'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks    
            X = rngArea.Value2
            For lngRow = 1 To rngArea.Rows.Count
                For lngCol = 1 To rngArea.Columns.Count
                    'replace the leading zeroes
                    X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), vbNullString)
                Next lngCol
            Next lngRow
            'Dump the updated array sans leading zeroes back over the initial range
            rngArea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
            rngArea.Value = objReg.Replace(rngArea.Value, vbNullString)
        End If
    Next rngArea

    'cleanup the Application settings
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
    End With

    Set objReg = Nothing
End Sub

 

[shum2934]

Thanks Dave for the awesome code!!

 

[Rick Rothstein]

Here is a function that will return a one-dimensional array for the specified list of columns on the specified worksheet where the data's starting row is specified...

Function GetArrayFromColumns(SheetName As String, StartRow As Long, ParamArray Cols()) As Variant
  Dim LastRow As Long, C As Variant, Text As String, WS As Worksheet, MyArray() As String
  If SheetName = "" Then SheetName = ActiveSheet.Name
  Set WS = Worksheets(SheetName)
  For Each C In Cols
    LastRow = WS.Cells(Rows.Count, C).End(xlUp).Row
    Text = Text & Chr(1) & Join(WorksheetFunction.Transpose(WS.Range(WS.Cells(StartRow, C), WS.Cells(LastRow, C))), Chr(1))
  Next
  GetArrayFromColumns = Split(Mid(Text, 2), Chr(1))
End Function

You can pass in the empty string ("") for the SheetName argument if you want the code to execute against the ActiveSheet. Here is a sample macro that shows this function in use...

Sub Test()
  Dim Z As Long, MyArray() As String
  MyArray = GetArrayFromColumns("Sheet1", 2, "A", "B", "C", "I", "AU")
  For Z = LBound(MyArray) To UBound(MyArray)
    Debug.Print MyArray(Z)
  Next
End Sub

This macro will run against Sheet1, it will assume the data starts on Row 2 and it will process all the data in Columns A, B, C, I and AU printing out the contents of the returned array to the Immediate Window inside the VB editor. You can declare your array (the one that receives the output from the function) as Variant or as String() only... the elements of the returned array will all be String values (even if the cells in the specified columns contained real Excel numbers).

 

[brettdj]

No probs, glad to have helped

 

[Peter_SSs]

I understand I could do this by looping through thousands of lines of data, but surely there is a more efficient way than this!

I'm not sure if you are referring to efficiency of writing the code or its run-time. I also am not sure if you were contemplating looping through the worksheet "lines of data" or array "lines of data".

This is not an area I'm strong in so I'm happy to have comments from Dave/Rick (or anybody else ) but even with looping, this code took approximately 0.08 seconds to process your desired columns of 7,000 rows into xarray.

Option Base 1

Sub DataToArray()
    Dim xarray, tmparray, myCols
    Dim i As Long, j As Long, LR As Long, c As Long, y As Long
        
    myCols = Array(1, 2, 3, 9, 47) '<-Cols A,B,C,I,AU
    
    y = UBound(myCols)
    LR = Range("A" & Rows.Count).End(xlUp).Row
    ReDim xarray(0 To LR - 1, 0 To y - 1)
    tmparray = Range("A1").Resize(LR, myCols(y)).Value
    For i = 1 To y
        c = myCols(i)
        For j = 1 To LR
            xarray(j - 1, i - 1) = tmparray(j, c)
        Next j
    Next i
End Sub

 

[pgc01]

Hi

Another option:

Sub Test()
Dim vArr As Variant
 
vArr = Application.Index(Range("A:AU"), [row(1:7000)], Array(1, 2, 3, 9, 47))
End Sub

 

[Peter_SSs]

Very concise, as usual, Pedro. I can see that it does work but I don't really understand this part
[row(1:7000)]
Can you explain that?

And how could we feed a variable into that part (eg LastRow)?

 

[pgc01]

Hi Peter

Here you use .Index() to extract the intersection of 2 sets of rows and columns. You must specify arrays with the values for the rows and columns that you want.

For ex., to extract the intersection of rows (2,13,5), notice the order of the rows, and columns (A,D), the result being the array 3x2 with (A2,A13,A5,D2,D13,D5),

Dim vArr As Variant
 
With Application
    vArr = .Index(Columns("A:D"), .Transpose(Array(2, 13, 5)), Array(1, 4))
End With

Notice that this is exactly the same syntax you'd use on the worksheet. Select F3:G5, enter

=INDEX(A:D,{2;13;5},{1,4})

in the formula bar and confirm with CSE. You'll get the values.


In the case of this thread you want all the rows 1:7000. I used [Row(1:7000)] as a quick way to generate the vertical array with all the values for the rows that I want.

Since [ ... ] is just a shorthand for Evaluate(), if the the value of the last row is in a variable you could use, for ex.:

Dim vArr As Variant, vRows As Variant
Dim lLastRow As Long
 
lLastRow = 10
vRows = Evaluate("row(1:" & lLastRow & ")")
 
vArr = Application.Index(Columns("A:D"), vRows, Array(1, 4))

This gets you an 10x2 array with (A1:A10,D1:D10)

 

[Rick Rothstein]

Sub Test()
Dim vArr As Variant
 
vArr = Application.Index(Range("A:AU"), [row(1:7000)], Array(1, 2, 3, 9, 47))
End Sub

Dim vArr As Variant
 
With Application
    vArr = .Index(Columns("A:D"), .Transpose(Array(2, 13, 5)), Array(1, 4))
End With

Dim vArr As Variant, vRows As Variant
Dim lLastRow As Long
 
lLastRow = 10
vRows = Evaluate("row(1:" & lLastRow & ")")
 
vArr = Application.Index(Columns("A:D"), vRows, Array(1, 4))

Let me start by saying... WOW!... this INDEX approach is incredibly fast and yet, at the same time, quite flexible. I've been playing around with it for a little while and I have a couple of observations which may prove useful to others when they implement this approach into their own coding.

First, the first argument to the INDEX function can be simplified to a call to the worksheet's Cells property. In timed test, I found no measurable difference between using something like Range("A:AU") and using Cells, so that should simplify constructing the INDEX statement somewhat. To illustrate, this line of code...

vArr = Application.Index(Range("A:AU"), [row(1:7000)], Array(1, 2, 3, 9, 47))

could be written like this (with no apparent loss in execution speed)...

vArr = Application.Index(Cells, [row(1:7000)], Array(1, 2, 3, 9, 47))

Second, all uses of the Array function call can be replaced with calls to the Split function instead, again, with no measurable loss in execution speed. So, where you have this...

Array(1, 2, 3, 9, 47)     or this     .Transpose(Array(2, 13, 5))

it can be replaced with this...

Split("1 2 3 9 47")     or this     .Transpose(Split("2 13 5"))

where I am using the default space delimiter for simplicity. Because the Split function takes a String argument, it lends itself to constructing the column references dynamically.

Hopefully some of you will find these observations useful.