Read a Range into an Array

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
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.

Thanks in Advance.
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
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
 
Upvote 0
Thanks for the reply dcardno,

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.

Thanks in Advance.
 
Upvote 0
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(n) 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(n).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
 
Upvote 0
Hi dcardno,

Thanks VERY much for your reply.
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 

Private Sub Form_Load() 
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 ).

Thanks in Advance.
 
Upvote 0
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...
 
Upvote 0
Thanks for the reply dcardno,
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

Thanks for all your help.
 
Upvote 0
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...
:)
 
Upvote 0
Thanks for the reply dcardno,

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?.

Thanks in Advance.
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,144
Members
448,552
Latest member
WORKINGWITHNOLEADER

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top