Define VBA array from excel range

[dcase]

Hi All,

Have put together a macro to loop through filtering a list then printing the filtered list:

Private Sub PrintAllSheets_Click()

CustNo = Array("1010", "1016", "1017", "1018")
For i = 0 To 3
Selection.AutoFilter Field:=15, Criteria1:=CustNo(i)
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Next i

End Sub

Rather than defining the array manually, I would like to populate it from the following range: Sheets("Affected Customers").Range("A1:A4"). Have tried replacing Array("1010", "1016", "1017", "1018") with Array(Sheets("Affected Customers").Range("A1:A4")) but doesn't work.

Any ideas?

 

[Richard Schollar]

Why would you want5 to do that? Is it for some kind of onward processing? Wouldn't it be simpler to just load the array into a 2D variant array and then iterate thur that by column? The effect would be the same and would be very fast.

 

[SamTYler]

Set a variant = The Range
Dim an array(Rcount*Ccount)
For J = 1 to Rc
For K = 1 to Cc
Arrary(J*K) = Variant(J, K)

 

[mountainclimber11]

Richard- I'd have to rewrite a considerable amount of code to accomidate a 2-D array. I use this array a lot in the rest of the code. Plus, I get this array only a few thousand times early on in my program and later on I use the array a lot inside loops literally millions of times. (Its a permutation/optimization program.) In other words, any extra steps that only take a tiny bit of time later on in the program turn out to be killers time-wise for me and a few wasted seconds early in the program aren't nearly as bad for speed b/c they aren't repeated nearly as much. Hopefully that make sense. Kill a little time now to save a bunch later kind of thing... Thanks for the feedback though...

Why would you want5 to do that? Is it for some kind of onward processing? Wouldn't it be simpler to just load the array into a 2D variant array and then iterate thur that by column? The effect would be the same and would be very fast.

 

[Richard Schollar]

Fair enough

Did you try Sam's suggestion?

 

[mountainclimber11]

Sam-
This didn't work for me.

Set a variant = The Range
Dim an array(Rcount*Ccount)
For J = 1 to Rc
For K = 1 to Cc
Arrary(J*K) = Variant(J, K)

Maybe I misunderstood though:

'my code for sam's post
'Dim d2Array As Variant'
'd2Array = Range("C1:D3").Value
'Dim d1Array(3 * 2) As String
'For j = 1 To 3
 '   For k = 1 To 2
  '  d1Array(j * k) = d2Array(j, k)
'    MsgBox j * k & " =idx k= " & k & " j= " & j
   ' Next k
'Next j
 
'my work around
Function TableToArray2() As String()
Dim d2Array As Variant
d2Array = Range("C1:D3").Value
ReDim d1Array(Application.CountA(Cells)) As String
Dim idx As Integer
For j = 1 To 2
    For k = 1 To 3
    idx = idx + 1
    If d2Array(k, j) = "" Then
        GoTo done
    End If
    d1Array(idx) = d2Array(k, j)
    'MsgBox idx & " =idx k= " & k & " j= " & j
    Next k
Next j
done:
TableToArray2 = d1Array
End Function

If I run the first one on columns that look like this:
a d
b e
c

The 1-d array index goes 1,2,3,2,4,5 which is wrong. Also it does not build a 5 element array since the bottom rght cell is empty. Did I misunderstand the post?

The second one, my work around, does what I want, but is it the fastest way to do it? TableToArray2 is much faster than my original TableToArray.

 

[SamTYler]

Yep! that's what I had in mind.

You might try version 1 after changing this

d2Array = Range("C1:D3").Value

to

d2Array = Range("C1:D3")

But you will need to use the

    For k = 1 To 3
    idx = idx + 1

from version 2. Mybad

You are already out of my comfort zone, so I can only offer suggestions.

 

[tusharm]

Hopefully not because it cannot work. {grin}

J*K will yield the same result for j=1,k=2 and k=2,j=1!

Fair enough

Did you try Sam's suggestion?

 

[SamTYler]

Oops! just change the code as suggested in V2, not V1

 

[mountainclimber11]

So I tested TableToArray and TableToArray2 (as I would use them in my program...see below) and TableToArray2 takes 8% of the time TableToArray takes if there are a lot of rows (which is how I am using it). The meat of the time wasted in TableToArray is probably due to the ReDim'ing that I do.

I'm still not convinced TabelToArray2 can't be faster...still taking suggestions!

Function TableToArray2(wb As String, sht As Integer) As String()
With Workbooks(wb).Sheets(sht)
    Dim d2Array As Variant
    d2Array = .Range("C1", FindLastCell())
    ReDim d1Array(Application.CountA(.Cells)) As String
    'MsgBox UBound(d1Array)
    Dim idx As Integer
    'MsgBox LastRowInOneColumn(3, wb, sht) & " rows"
    For j = 1 To Application.CountA(.Columns)
        For k = 1 To LastRowInOneColumn(3, wb, sht)
        idx = idx + 1
        If d2Array(k, j) = "" Then
            GoTo done
        End If
        d1Array(idx) = d2Array(k, j)
        'MsgBox idx & " =idx k= " & k & " j= " & j
        Next k
    Next j
done:
End With
TableToArray2 = d1Array
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
Function TableToArray(wb As String, sht As Integer) As String()
ReDim A(1) As String
Dim rw As Long
rw = 0
Dim col As Long
col = 3
Dim z As Range
With Workbooks(wb).Sheets(sht)
Dim c As Range
For Each c In .Range("C1", FindLastCell())
     cnt = cnt + 1
     rw = rw + 1
     tmp = .Cells(rw, col).Value
 
     If tmp = "" Then
        rw = 1
        col = col + 1
        tmp = .Cells(rw, col).Value
     End If
 
     If tmp <> "" Then
        ReDim Preserve A(cnt)
        A(cnt) = tmp
 
     End If
 
Next
End With
TableToArray = A
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function LastRowInOneColumn(xcol As Long, wb As String, sht As Integer) As Long
'Find the last used row in a Column: column A in this example
    Dim xLastRow As Long
    With Workbooks(wb).Sheets(sht)
        xLastRow = .Cells(.Rows.count, xcol).End(xlUp).row
    End With
 
LastRowInOneColumn = xLastRow
End Function
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function FindLastCell() As Range
Dim theLastColumn As Integer
Dim theLastRow As Long
Dim theLastCell As Range
With ActiveSheet
    If WorksheetFunction.CountA(Cells) > 0 Then
        'Search for any entry, by searching backwards by Rows.
        theLastRow = .Cells.Find(What:="*", after:=[a1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
        'Search for any entry, by searching backwards by Columns.
                theLastColumn = .Cells.Find(What:="*", after:=[a1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
                Set FindLastCell = .Range(Cells(theLastRow, theLastColumn).Address)
    End If
 
End With
End Function

 

[tusharm]

Even faster might be to write a "data abstraction layer." And, this would be a great place to use a Property in a standard module!

For more on the subject of properties in a standard module see
Case Study – Property procedures in a standard module
http://www.tushar-mehta.com/publish_train/xl_vba_cases/vba-property_procs_in_std_module.htm

Back to your problem...for my test I had data in A1:B20.

Option Explicit

Dim C As Integer, R As Long
Dim Arr
Sub Initialize(Cell1 As Range)
    Arr = Cell1.CurrentRegion.Value
    C = UBound(Arr, 2)
    R = UBound(Arr)
    End Sub

Property Get MyArr(I)
    MyArr = Arr((I - 1) Mod R + 1, ((I - 1) \ R) + 1)
    End Property
Property Let MyArr(I, uVal)
    Arr((I - 1) Mod R + 1, ((I - 1) \ R) + 1) = uVal
    End Property

Sub testProps()
    Initialize Cells(1, 1)
    MsgBox MyArr(1) & "," & MyArr(10) & "," & MyArr(11) & "," & MyArr(20)
    MyArr(11) = 11
    MsgBox MyArr(11)
    End Sub

{snip}

The second one, my work around, does what I want, but is it the fastest way to do it? TableToArray2 is much faster than my original TableToArray.