# Read a Range into an Array

#### S.H.A.D.O.

##### Well-known Member
Hi everyone,

In a Worksheet named "Input" and in Cells "B3:G?" I have 6 number groups. How can I ...

( 1 ) Put each of the 6 number groups into an array when I don't know what the last row number is.

( 2 ) Find the maximum value in any of those cells and attach it to a variable named MaxVal.

... so once I have done this I can then loop through each 6 number group and perform some calculations.

### Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

#### dcardno

##### Well-known Member
You can read a range of values directly into a VBA array if you declare a variant to hold the array - the first index of the array will represent the row and the second index will represent the column. If your data is laid out in a table with no continuous (whole row or whole column) breaks you can use the "CurrentRegion" attribute to define the data range you are interested in. Note - the data has to be surrounded by completely blank rows and columns above and below and left and right, otherwise the data transferred into the array will include extraneous information (and the first / last elements might not be correctly identified). With those caveats, something like this might work (warning air code):
Code:
``````Sub GetData

Dim rgData as Range
Dim arData as Variant
Dim dlMaxVal as Double

set rgdata = worksheets("Input").range("B3").CurrentRegion
arData = rgData
' access data in each column using arData(1,1), arData(2,1)...
' determine max index value (depends on number of rows of
' data) with Ubound(arData,1)
' access data in each row using arData(1,1), arData(1,2)... up to
' arData(1,6) for first element from Column G or test for Ubound(arData,2)

dlMaxVal = Worksheetfunction.Max(rgData)
' you wondered why I defined that range, didn't you?
' continue processing

End Sub``````

If you cannot set up the data so "CurrentRegion" works, you will have to identify the number of rows required using the xlEndDown method from the start of the data table if all columns have the same number of data rows. If not, you will have to think about how to determine the number of rows at run time

#### S.H.A.D.O.

##### Well-known Member

I have set up the following to get the range for ALL the 6 number groups in the Worksheet named "Input" and in Cells "B3:G?".

Code:
``````Dim rng As Range

set rng = Worksheets("Input").Range("B3:G" & Range("B3").End(xlDown).Row)``````
At the moment the groups are hard coded in the program ...

SetGroup 1, 1, 2, 3, 4, 5, 9
SetGroup 2, 1, 3, 5, 6, 7, 9
SetGroup 3, 2, 4, 5, 6, 7, 8

... etc. I want to be able to get the following Sub to recognise each 6 number group from the spreadsheet please instead of the hard coded ones.

Code:
``````Private Sub SetGroup(ByVal Index As Long, ParamArray Num())
Dim vlu, cell As Long, bit As Long
Dim dgt As Digits, Wh As Wheel

For Each vlu In Num
cell = vlu \ 8
bit = vlu And 7
dgt.B(cell) = dgt.B(cell) Or (2 ^ bit)
Next
LSet Wh = dgt
WHL(Index).A = Wh.A
End Sub``````
I need to use the exact same variables ( plus any that need to be added ) in the Sub above as they are used elsewhere in the program.

#### S.H.A.D.O.

##### Well-known Member
Has anybody got any ideas please?.

#### dcardno

##### Well-known Member
SHADO - I am not exactly sure what you are doing - it appears that this routine is called from somewhere else, with parameters of the index (I assume running from 1 to 6 representing the columns of data B through G) and the values obtained as a paramarray (ie SetGroup), either hard-coded as now, or -preferably- picked up from the s/sheet; is that correct? I am not familiar with the data types Digits or Wheel - I assume that they are classes you have created elsewhere in your program; is that correct? It appears that you are performing a chain of calculations using each value down the selected column in succession, and then reporting out a final result.

On those assumptions, and assuming that you are going to use the approach noted before to place the values in the range B3:Gn into an array called arData, I would try something like:
Code:
``````Private Sub SetGroup(ByVal Index As Long)
Dim iRow as long

Dim vlu, cell As Long, bit As Long
Dim dgt As Digits, Wh As Wheel

For iRow = 1 to ubound(arData,1)
vlu = arData(iRow,Index)
cell = vlu \ 8
bit = vlu And 7
dgt.B(cell) = dgt.B(cell) Or (2 ^ bit)
Next iRow
LSet Wh = dgt
WHL(Index).A = Wh.A
End Sub``````
If this is called with SetGroup it will proceed to perform the calculations down Column "n", where n=1 is Col B, n=2 is Col C, etc, and load the results into WHL.A. I imagine this would be called from within a loop with n set from 1 to UBound(arData,2)... and it coding it that way in this routine would probably make things clearer

#### S.H.A.D.O.

##### Well-known Member
Hi dcardno,

Here is the code that I have at the moment ...

Code:
``````Option Explicit
Private Type Wheel
A As Currency
End Type

Private Type Digits
B(0 To 7) As Byte
End Type

Private BC(0 To 255) As Byte
Private WHL(0 To 20) As Wheel ' Do not use 0th item
Private Tested As Long

Const POOL = 9

Dim idx As Currency, tly&, cmb&, pik&, win&

' Build bit count lookup table
For idx = 0 To 255
BC(idx) = Nibs(idx And 15) + Nibs(idx \ 16)
Next

' Enumerate different combinations
For cmb = 1 To POOL
tly = 0
For idx = 0 To (2 ^ POOL) - 1
If BitCount(idx / 5000) = cmb Then
tly = tly + 1
End If
Next
Debug.Print "For 1 -"; POOL; "there are"; tly; "different combinations of"; cmb; "numbers."
Next

SetWheel 1, 1, 2, 3, 4, 5, 9
SetWheel 2, 1, 3, 5, 6, 7, 9
SetWheel 3, 2, 4, 5, 6, 7, 8

Debug.Print
Debug.Print "Result", "Covered", "(Tested)"

' Find matches
win = 7
For pik = 2 To win
For cmb = 2 To pik
Tested = 0
tly = Matching(cmb, pik, win)
Debug.Print cmb; "if"; pik, tly, "("; Tested; ")"
Next
Next
End Sub

Private Sub SetWheel(ByVal Index As Long, ParamArray Num())
Dim vlu, cell As Long, bit As Long
Dim dgt As Digits, Wh As Wheel
For Each vlu In Num
cell = vlu \ 8
bit = vlu And 7
dgt.B(cell) = dgt.B(cell) Or (2 ^ bit)
Next
LSet Wh = dgt
WHL(Index).A = Wh.A
End Sub

Private Function Matching(ByVal match As Long, ByVal pick As Long, ByVal win As Long) As Long
Dim op1 As Wheel, op2 As Wheel
Dim idx1 As Long, idx2 As Long

' Loop through all possible combinations
For idx1 = 0 To (2 ^ POOL)
' Limit to the 'if X' value
If BitCount(idx1 / 5000) = pick Then
op1.A = idx1 / 5000
DoEvents
Tested = Tested + 1
' Loop through items in wheel
idx2 = 1
While WHL(idx2).A > 0
op2.A = WHL(idx2).A
idx2 = idx2 + 1
' Check for matching numbers
If BitCount(BigAnd(op1, op2)) >= match Then
Matching = Matching + 1
' Point to 0th item in wheel to exit loop
idx2 = 0
End If
Wend
End If
Next

End Function

Private Function BigAnd(W1 As Wheel, W2 As Wheel) As Currency
Dim d1 As Digits, d2 As Digits, d3 As Digits
Dim idx As Long
LSet d1 = W1
LSet d2 = W2
For idx = 0 To 7
d3.B(idx) = d1.B(idx) And d2.B(idx)
Next
LSet W2 = d3
BigAnd = W2.A
End Function

Private Function BitCount(ByVal X As Currency) As Long
Dim W As Wheel, d As Digits
Dim idx As Long, cnt As Long
W.A = X
LSet d = W
For idx = 0 To 7
cnt = cnt + BC(d.B(idx))
Next
BitCount = cnt
End Function

Private Function Nibs(ByVal Value As Byte) As Long
Select Case Value
Case 0
Exit Function
Case 1, 2, 4, 8
Nibs = 1
Exit Function
Case 3, 5, 6, 9, 10, 12
Nibs = 2
Exit Function
Case 7, 11, 13, 14
Nibs = 3
Exit Function
Case 15
Nibs = 4
End Select
End Function``````
... and as you can see there are 3 SetWheel combinations hard coded, these are there so that the rest of the code could be tested.
What I would like the program to do is pick up ALL the 6 number combinations in the Excel sheet named "Data" and in Cells "B3:G?" and evaluate those instead of those that are hard coded ( the combinations will always start in Cell "B3" BUT the Cell "G?" will change depending on the number of combinations to evaluate ).

#### dcardno

##### Well-known Member
Shado - I don't follow what you are trying to do overall, but I think I can help with this sub-set of your problem. As I understand it, the SetWheel command(s) currently hard-coded in your routine will set Whl(1) (the first item in an array of Wheels), by performing the required calculations on the values 1, 2, 3, 4, 5, 9; then set Whl(2) by perfoming the same calculations on 1, 2, 3, 5, 6, 7, 9; and finally set whl(3) by performing calculations on 2, 4, 5, 6, 7, 8. You would like to have those numbers picked up from columns staring in Cell B3, and you would like it to be generalized to accept any number of input values; If there are more values to be used in the computation they will extend down to -say- row 15 or 20 etc.
The spreadsheet layout for the values you now have hard-coded would be:
B3: 1
B4: 2
B5: 3
B6: 4
B7: 5
B8: 9

C3: 1
...
C8: 9

D3: 2
...
D8: 8

The routine will always be reading values from Columns B through G, and using them to set whl(1) through whl(6). Incidentally, why is whl() dimmed with a UBound of 20?

To make things easier, I would start by defining a named range for Cell B3 - it makes things a little easier to adapt if, say, you decide to move the inlut area to D4... I assume that it will have the name "DataStart." Finally, I assume that the data will be continuous down the columns, and that there will be a blank row below the data...

In the routine Sub Form_Load define two variables as
Code:
``````Dim iDataRows   As  Long
Dim i As Integer``````
where you are now issuing the SetWheel command, replace that with
Code:
``````iDataRows = [Datastart].end(xlDown).row - [datastart].row
for i = 1 to 6
SetWheel i, iDataRows
next i``````
Change the SetWheel routine as follows:
Code:
``````Private Sub SetWheel(Index As Long, iRows as Long)
Dim vlu
Dim cell As Long
Dim bit As Long
Dim dgt As Digits
Dim Wh As Wheel
Dim i as long
For i = 0 to iRows
cell = [datastart].offset(i , index - 1) \ 8
bit = [datastart].offset(i , index - 1) And 7
dgt.B(cell) = dgt.B(cell) Or (2 ^ bit)
Next i
LSet Wh = dgt
WHL(Index).A = Wh.A
End Sub``````

It seems to me that you will not generate all possible values of "cell" if the dataset does not inlude all integers from 1 to 8, so dgt.B will have some nulls in it. As I said, I am not sure what you are trying to do, so I don't know if this is a problem or not...

#### S.H.A.D.O.

##### Well-known Member
As I understand it, the SetWheel command(s) currently hard-coded in your routine will set Whl(1) (the first item in an array of Wheels), by performing the required calculations on the values 1, 2, 3, 4, 5, 9; then set Whl(2) by perfoming the same calculations on 1, 2, 3, 5, 6, 7, 9; and finally set whl(3) by performing calculations on 2, 4, 5, 6, 7, 8. You would like to have those numbers picked up from columns staring in Cell B3, and you would like it to be generalized to accept any number of input values; If there are more values to be used in the computation they will extend down to -say- row 15 or 20 etc
Yes, that is exactly what I would like.
The spreadsheet layout for the values you now have hard-coded would be:
B3: 1
B4: 2
B5: 3
B6: 4
B7: 5
B8: 9

C3: 1
...
C8: 9

D3: 2
...
D8: 8

The routine will always be reading values from Columns B through G, and using them to set whl(1) through whl(6). Incidentally, why is whl() dimmed with a UBound of 20?
No, the 6 number groups are in Cells B3 to G whatever. There could be 10 groups or 100 groups or whatever. The first group is in Cells B3:G3, the second group is in Cells B4:G4 and so on. The groups will be continuous down the columns, and that there will be a blank row below the data.

I have included all your other amendments but I am unsure where to incorporate this code ...
Code:
``````iDataRows = [Datastart].end(xlDown).row - [datastart].row
for i = 1 to 6
SetWheel i, iDataRows
next i``````

#### dcardno

##### Well-known Member
Okay - I had the orientation of the "groups" wrong - I was reading "six number groups" as "six groups, each with an unknown number of members" rather than "an unknown number of groups, each of which consists of six numbers..."

The piece of code you were asking about goes in place of the 3 SetWheel statements you have in the code now and perform the SetWheel operation on the hard-coded values "1, 2, 3, 4, 5, 9, then on "1, 3, 5, 6, 7, 9" etc. Since the groups run horizontally, that code will have to be changed, as will the SetWheel routine, but the changes are fairly minor: The code you were asking about should run in a loop based on the number of rows of data, rather than from 1 to 6; the SetWheel loop should be from one to six or zero to five. The latter approach allows the index to be used directly as the column offset value from the named range "DataStart" rather than setting the offset as "i-1"

I think the code would look like this:
In the FormLoad routine (in place of the SetGroup just discussed):
Code:
``````iDataRows = [Datastart].end(xlDown).row - [datastart].row
for i = 0 to iDataRows
SetWheel i + 1
next i``````

You won't need to pass the iRows parameter to SetWheel, and it will look something like this:
Code:
``````Private Sub SetWheel(Index As Long)
Dim vlu
Dim cell As Long
Dim bit As Long
Dim dgt As Digits
Dim Wh As Wheel
Dim i as long
For i = 0 to 5
cell = [datastart].offset(i , index - 1) \ 8
bit = [datastart].offset(i , index - 1) And 7
dgt.B(cell) = dgt.B(cell) Or (2 ^ bit)
Next i
LSet Wh = dgt
WHL(Index).A = Wh.A
End Sub``````

Let me know how it goes...

#### S.H.A.D.O.

##### Well-known Member

I am unsure what [datastart] is.
Is it a "Named" range that I have to set up?.
If so, how do I set the named range for the sheet named "Data" and the Cells "B3:G?" when I don't know what the last row will be. What would the code be?.
Would it be somethong like ...

Set [datastart] = Worksheets("Data").Range("B3:G" & Range("B3").End(xlDown).Row)

... or something else?.

Replies
6
Views
78
Replies
1
Views
145
Replies
0
Views
77
Replies
1
Views
28
Replies
14
Views
255

1,191,119
Messages
5,984,758
Members
439,909
Latest member
daigoku

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back