Read a Range into an Array

S.H.A.D.O. · Aug 10, 2007

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.

dcardno · Aug 17, 2007

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

I had anticipated that you would just create a named range in Excel, calling Cell B3 on the "Data" tab "DataStart" - I think that's a lot easier than trying to create (and re-create) the name in code. The range should just be a single cell - the offset method will just use that cell as a base and examine values as determined by the offset parameters at each step in the loop(s). Since the loop runs from 1 (or zero - I can't recall) to [Datastart].end(xlDown).row - [datastart].row each time the code runs it will automatically adapt to the number of rows of data you are providing.
One thing that just occurred to me - and I haven't gone back to check - is that you have a an array of "Wheel" data types, and IIRC the UBound of that array is 20. You have remarked that you might have up to one hundred rows of data - I believe each one will take up one s[pot in the array. If so, when used in a production environment, you should be redimming that array so that the Ubound is determined by 1 + [Datastart].end(xlDown).row - [datastart].row otherwise you will get a "subscript out of range" error

S.H.A.D.O. · Aug 17, 2007

Thanks for the reply,

I had anticipated that you would just create a named range in Excel, calling Cell B3 on the "Data" tab "DataStart" - I think that's a lot easier than trying to create (and re-create) the name in code. The range should just be a single cell - the offset method will just use that cell as a base and examine values as determined by the offset parameters at each step in the loop(s). Since the loop runs from 1 (or zero - I can't recall) to [Datastart].end(xlDown).row - [datastart].row each time the code runs it will automatically adapt to the number of rows of data you are providing.

I have setup Cell "B3" in the sheet named "Data" as the named range "datastart".

One thing that just occurred to me - and I haven't gone back to check - is that you have a an array of "Wheel" data types, and IIRC the UBound of that array is 20. You have remarked that you might have up to one hundred rows of data - I believe each one will take up one s[pot in the array. If so, when used in a production environment, you should be redimming that array so that the Ubound is determined by 1 + [Datastart].end(xlDown).row - [datastart].row otherwise you will get a "subscript out of range" error

Is there an easier way to do this then, if not, how would I get it to do as you have suggested using the redim method, I have no idea how to approach this.

Thanks in Advance.

dcardno · Aug 17, 2007

Is there an easier way to do this then...

No

Fortunately, it isn't difficult. In your code you have a statement that declares the WHL array:
Private WHL(0 To 20) As Wheel ' Do not use 0th item
change that to
Private WHL() As Wheel ' Do not use 0th item

At this point, you have created an array of "Wheel" data types - but you have not told Excel how big that array might be. Until you do, you can't use it! You tell Excel how big the array is by re-dimensioning it, which you would likely do by:

Code:

iDataRows = [Datastart].end(xlDown).row - [datastart].row 
Redim WHL(0 to iDataRows)
for i = 0 to iDataRows 
SetWheel i + 1 
next i

One warning - there may well be a couple of "off-by-one" errors in there or elsewhere in the code described: it's hard to keep your index bases straight when you are just dealing with bits and pieces. You should give it a good review - and if the results aren't what you expect whne you run it on test cases, that's the first place I would look.

S.H.A.D.O. · Aug 18, 2007

Hi dcardno,

I have applied your changes but unfortunately it still does not work, it keeps saying object required Run-time error 424 even though I have named cell "A1" as datastart on line ...

Code:

iDataRows = [datastart].End(xlDown).Row - [datastart].Row

The code I have so far is as follows :-

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 WHL() As Wheel ' Do not use 0th item
Private Tested As Long

Const POOL = 9

Sub Form_Load()
Dim idx As Currency, tly&, cmb&, pik&, win&, output&, p&, tlyn&
Dim iDataRows As Long
Dim i As Integer

  ' 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
        
        'If BitCount(idx / 5000) < cmb Then
                 '   tlyn = tlyn + 1
               ' End If
        
      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
  
  iDataRows = [datastart].End(xlDown).Row - [datastart].Row
  ReDim WHL(0 To iDataRows)
  For i = 0 To iDataRows
    SetWheel i + 1
  Next i

  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(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

'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

It is so close to the finished product.
Thanks in Advance.

dcardno · Aug 18, 2007

even though I have named cell "A1" as datastart on line ...

But I thought your data started at B3? If so, that's the cell that should be the named range "DataStart." Note - I would just name that range in Excel, rather than trying to do it at run-time through VBA...

If it doesn't work, try stepping through the program, with the immediate and local windows open - perhaps set a watch on some of the variables and see if they change the way you expect them to as the program executes. In the intermediate window, issue the command:

Code:

 ? range("datastart").row

- it should return 3 (if DataStart is defined as $B$3). Try

Code:

? [datastart].End(xlDown).Row

- it should return the last row of data...

BTW: Range("datastart") and [datastart] are equivalent expressions - the square brackets force an evaluation of whatever is contained within them

S.H.A.D.O. · Aug 19, 2007

Hi dcardno,

Thanks for the reply.
I have changed ...

Code:

Private WHL(0 to 20) As Wheel ' Do not use 0th item

... to ...

Code:

Private WHL() As Range ' Do not use 0th item

... ( and several other variations ) but I get a ...

Run-time error '91'
Object variable or With block variable not set

... on line ...

Code:

  WHL(Index).A = Wh.A

Does the "Private Function BigAnd" need to be adapted as well please.
Any ideas willl be greatly appreciated.
Thanks in Advance.

dcardno · Aug 19, 2007

SHADO -
I think WHL() should still be an array of "Wheel" data types, although I admit that I haven't really thought much about what that data type does, or why it would be preferred to -say- an array. I assume that the usual advantage of a new data type is that you can store different types of data - numeric, text, and object references all in one object; in an array you are limited to one data type unless you declare an array of variants - and then you lose type enforcement for each data element, unless enforced programatically.

So... by declaring

Code:

Dim WHL() As Range

you have created an array of Range references - this conflicts with the way that the Wheel data type was previously used since "Wheel" contains a Currency data type.

Anyway - a couple of things to think about: in looking at the code, I can't see any reason to create the "Wheel" data type since it ony contains one element; what was your intention in creating it? How does the original code run when you have the three SetWheel commands with values hard-coded? If that runs properly, then I can't see anything in the subsequent changes that would affect it. One alternative (and perhaps preferable) solution would be to call the prior SetWheel (since it is known to work) and pull the values for the ParamArray out of the s/sheet using something like:

Code:

iDataRows = [Datastart].end(xlDown).row - [datastart].row 
Redim WHL(0 to iDataRows) 
for i = 0 to iDataRows 
SetWheel i + 1, _
[datastart].offset(0,i), _
[datastart].offset(1,i), _
[datastart].offset(2,i), _
[datastart].offset(3,i), _
[datastart].offset(4,i), _
[datastart].offset(5,i)
next i

- note, I am not sure that a ParamArray will accept the line-continuation character - there's no reason why it shouldn't, but I don't have Excel loaded on this machine, so I can't check the on-line help...

By the way - just what are you trying to do in this program?

dcardno · Aug 19, 2007

SHADO - Mea Culpa, Mea Maxima Culpa

I gave you the wrong code for the SetWheel routine - instead of reading subsequent values in one "number group" across, it is reading them down! When I replace that code with the following:

Code:

Private Sub SetWheel2(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(Index - 1, i) \ 8
    bit = [datastart].Offset(Index - 1, i) And 7
    dgt.B(cell) = dgt.B(cell) Or (2 ^ bit)
Next i
LSet Wh = dgt
WHL(Index).A = Wh.A
End Sub

I also had an off-by-one error, and in the Form_Load sub I had to change the ReDim of WHL() to:

Code:

ReDim WHL(0 To iDataRows + 1)

After making those changes, I get the same results for WHL(1) to WHL(3) as when I use the hard-coded values you have input for testing.

The routine still errors out, though, in the "Matching" function, since you are trying to loop through all WHL(idx2) values, and idx2 assumes a value of 4, which creates a "subscript out of range" error. I am not sure what you are trying to do, but I suspect you need another test to exit the loop if idx2 > UBound(WHL)...

S.H.A.D.O. · Aug 20, 2007

Hi dcardno,

By the way - just what are you trying to do in this program?.

The Program I posted initially works GREAT except for ONE thing I would like to change.
The Program calculates the three SetWheels that are hard coded.
What I would like the Program to do INSTEAD of this is to pick up ALL the 6 number combinations in the sheet named "Data" and in Cells "B3:G?" and process them INSTEAD.
I would like it so that ALL the variables used and subsequent results produced throughout the Program are NOT affected by the amendment, so basically, the amendment(s) need to integrate with the rest of the code in the Program so it still all works correctly.
I don't know if the amended code needs to use "bits" instead of conventional programming. I only say this because I think I read somewhere that using "bits" greatly increases the speed of processing time and is easier to manage.

Thanks in Advance.

dcardno · Aug 20, 2007

As I said, when I make the changes discussed above, I get the same values for WHL(1) to WHL(3) when the three test number groups are in B3:G5 as when I run the earlier version of the code with those values hard-coded in. When I change the line

Code:

While WHL(idx2).A > 0

in the matching function to

Code:

While idx2 < UBound(WHL) AND WHL(idx2).A > 0

the routine goes on to output several lines of values for the "Result," "Covered" and "(Tested)" figures - having no idea what they are meant to be or represent, I can't say if they are correct, nor can I say whether the limitation on idx2 is appropriate given the intended calculation - only that it is required to let the program run without an error. Presumably, if you have only set values for -in this case- three wheels, you don't want to use the "zero values" that would be obtained with WHL(>3) even if you changed (or deliberately over-allocated) the UBound for the array.

One other question - are you sure you want to use the Currency data type for the Wheel data type? Is I understand it (which may not be that well) Currency is a scaled integer; a bunch of integer values that have the decimal place shifted by four positions. Like all integer calculations, it is absolutely accurate until it isn't, at which point it becomes absolutely inaccurate. In the case of Currency, it is accurate to four decimal places, and inaccurate thereafter. If you intend to use fractional results, should you be using a floating point data type? If not (although the WHL

values I observed were all fractional), should you be using an integer (or long) type?

Read a Range into an Array

S.H.A.D.O.

Well-known Member

dcardno

Well-known Member

Excel Facts

S.H.A.D.O.

Well-known Member

dcardno

Well-known Member

S.H.A.D.O.

Well-known Member

dcardno

Well-known Member

S.H.A.D.O.

Well-known Member

dcardno

Well-known Member

dcardno

Well-known Member

S.H.A.D.O.

Well-known Member

dcardno

Well-known Member

Similar threads

Forum statistics

Share this page

Read a Range into an Array

Well-known Member

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock