Reading Super Large Ranges from Worksheet into Array

M

Marston

Hi -

I'm setting up a budgeting application for work.
I have the results of all of our current year budgeted and actual
entries from our ERP system.
I need to read these in and sort them.

I'm not too worried about the sort - there is a great routine in John
Walkenbach's books (Chpt 11?)
The problem I'm having is in finding a good way to read the data in.

The data is in multiple workbooks because its too big to fit into a
single worksheet.
The ranges - when put together are something like 250,000 rows long by
11 rows wide.
I need to read this into an array. I was doing it cell by cell into an
array something like the following:

Range("A1").Offset(row,column).Select

MyArray(row,column) = ActiveCell.Value

But this is taking an enourmous amount of time.

To complicate things futher, our ERP system turns some numbers into
text when it dumps them
into Excel. Within a column, values are either numbers or text that
looks like numbers.

I'd like to convert them all to numbers as I read them in.

I set up routine that estimates how long it is going to take to
complete this task - and its something like over 5 hours....

Any suggestions?

Should I right a pre-processing routine that pastes the =value(cell)
formula on the actual worksheet, converting everything to numbers
first then run the routine to read numbers in?

Thanks for suggestions...
 
S

Stan Scott

Marston,

Someone can answer your particular question, but I want to stress this --
you have a DATABASE problem, not an EXCEL problem. A database, such as
Access, will have no trouble taking this data and sorting it. You can then
extract as much information as you need to an Excel workbook to do
calculations.

Stan Scott
New York City
 
A

Alan Beban

Marston said:
Hi -

I'm setting up a budgeting application for work.
I have the results of all of our current year budgeted and actual
entries from our ERP system.
I need to read these in and sort them.

I'm not too worried about the sort - there is a great routine in John
Walkenbach's books (Chpt 11?)
The problem I'm having is in finding a good way to read the data in.

The data is in multiple workbooks because its too big to fit into a
single worksheet.
The ranges - when put together are something like 250,000 rows long by
11 rows wide.
I need to read this into an array. I was doing it cell by cell into an
array something like the following:

Range("A1").Offset(row,column).Select

MyArray(row,column) = ActiveCell.Value

But this is taking an enourmous amount of time.

To complicate things futher, our ERP system turns some numbers into
text when it dumps them
into Excel. Within a column, values are either numbers or text that
looks like numbers.

I'd like to convert them all to numbers as I read them in.

I set up routine that estimates how long it is going to take to
complete this task - and its something like over 5 hours....

Any suggestions?

Should I right a pre-processing routine that pastes the =value(cell)
formula on the actual worksheet, converting everything to numbers
first then run the routine to read numbers in?

Thanks for suggestions...
Click to expand...

If you want to make available to your workbook the functions in the
freely downloadable file at http://home.pacbell.net/beban, you can
consider the following:

I didn't deal with converting the text values to numbers. I assume
that's a relatively trivial array formula that doesn't take appreciable
time to run.

And I didn't fill the cells with values so most of them were empty--I
don't know how that affects the speed of execution. I did put a value
in Cell A10 of the 4th worksheet so I could check to see that the values
were in fact loaded into the array.

I assumed that your values were in the first 4 worksheets, in A1:K62500
of each sheet (to end up with an array of 250,000 x 11). The following
procedure took slightly under 40 seconds to load the data into an array
(arr1) on my machine.

arr1 is implicitly dimensioned as a 62500x11 array (by loading it with
the elements from the 1st worksheet);
the ResizeArray function redimensions it to 250000x11;
The first ReplaceSubArray function replaces the portion of arr1
beginning at row 62501, column 1, with the elements from arr2 (i.e., the
elements from the 2nd worksheet);
The next two ReplaceSubArray functions do the same sort of thing for the
3rd and 4th worksheet elements.

Sub a()
'starttime = Now()
Dim arr1, arr2, arr3, arr4
Set ws1 = Worksheets(1)
Set ws2 = Worksheets(2)
Set ws3 = Worksheets(3)
Set ws4 = Worksheets(4)
arr1 = ws1.Range("a1:k62500").Value
arr2 = ws2.Range("a1:k62500").Value
arr3 = ws3.Range("a1:k62500").Value
arr4 = ws4.Range("a1:k62500").Value
ResizeArray arr1, 250000, 11
ReplaceSubArray arr1, arr2, 62501, 1
ReplaceSubArray arr1, arr3, 125001, 1
ReplaceSubArray arr1, arr4, 187501, 1
'Debug.Print arr1(187510, 1)
'Debug.Print (Now() - starttime) * 86400
End Sub

Alan Beban
 
M

Marston

Here are some of the issues with your suggestion
1) Our company only uses Filemaker db, not Access and we're actually
reducing the number
of copies, not adding. I've already had mine removed.
2) Once the information is sorted, it doesn't need to be "calculated"
on - it needs to be fed into
a series of several hundred workbooks that are "templates" for new
numbers to be entered in.
3) Once everyone has entered new data, this information is
re-aggregated and then converted into another series of worksheets -
no need for sorting this time, just aggregation.
4) Our ERP vendor (one of the biggies) only provided us with a tool to
upload Excel files into our system not Access
5) If there were going to be any calculations made - they would be of
the type that Access can not perform.
 
A

Alan Beban

The following is code that does not depend on any add-ins and will load
the contents of the Ranges A1:K62500 of the first 4 worksheets into a
250000x11 array. It takes less than 10 seconds on my machine.

Sub c()
Dim arr, arrws
ReDim arr(250000, 11)
ReDim arrws(1 To 4)
Dim i As Long, j As Integer, k As Integer
For i = 1 To 4
arrws(i) = Worksheets(i).Range("A1:K62500")
Next
For k = 1 To 4: For i = 1 To 62500: For j = 1 To 11
arr(i + (k - 1) * 62500, j) = arrws(k)(i, j)
Next: Next: Next
End Sub

Alan Beban
 
A

Alan Beban

The code in my previous posting can be slightly modified to coerce the
"text numbers" back to numbers as the array is loaded, a la

Dim arr, arrws
ReDim arr(250000, 11)
ReDim arrws(1 To 4)
Dim i As Long, j As Integer, k As Integer
For i = 1 To 4
arrws(i) = Worksheets(i).Range("A1:K62500")
Next
For k = 1 To 4: For i = 1 To 62500: For j = 1 To 11
arr(i + (k - 1) * 62500, j) = CDbl(arrws(k)(i, j))
Next: Next: Next

This assumes that all entries in the ranges are numeric, i.e., numbers
or text that look like numbers.

Alan Beban
 
M

Marston

Well the good news is - the new routines definately sped up the
process (down to a few seconds - which is easily acceptable)

The bad part is that for some reason, when I do a test write out of
the array to a new workbook, I get all blanks, so I must be doing
something wrong (I hope)

Here's my code:

Public RetStr(5) As String
Public fname(70) As String
Public aQuery() As Variant
Public FnAcctDept() As Variant
Public DeptFleet() As Variant
Public LocDept() As Variant
Public LocBldg() As Variant
Public rnglgth() As Variant

Sub FileOpen()
Dim i, j, k, n, o, p As Integer
Dim l, m As Long
Dim pct As Double
Dim sStr, fnStr As String
Dim rng, rng2, c As Range
On Error Resume Next
UserForm3.Hide
Unload UserForm3
Application.ScreenUpdating = False
Application.StatusBar = "Checking For Files...."
j = 0
k = 0
' RetStr(i) is a folder name gathered from another routine - this part
works
For i = 1 To 5
sStr = RetStr(i)
With Application.FileSearch
.NewSearch
.LookIn = sStr
.SearchSubFolders = False
.Filename = ".xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
o = o + .FoundFiles.Count
Application.StatusBar = o & " Files Found..."
' The next section checks if a file that is going to be opened happens
to already be open and closes it
' so that it can be read in read-only mode
If i < 5 Then
For j = 1 To .FoundFiles.Count
k = k + 1
ReDim Preserve rnglgth(k)
If WorkbookIsOpen(.FoundFiles(j)) Then
fnStr = .FoundFiles(j)
Workbooks(fnStr).Activate
ActiveWorkbook.Close ([False])
End If
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(j),
UpdateLinks:=False, ReadOnly:=True)
If i < 4 Then
' Depending on the file, certain rows are headers that I don't want
to count in my row totals
Rows("1:3").Select
Else
Rows("1:1").Select
End If
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveCell.CurrentRegion.Select
rnglgth(k) = Selection.Rows.Count
ActiveWorkbook.Close ([False])
Next
End If
Else
MsgBox "No file found in Folder " & sStr
UserForm3.Show
Exit Sub
End If
End With
Next i
For j = 1 To k
l = l + rnglgth(j)
Next
ReDim aQuery(l, 11)
Application.StatusBar = "Loading Queries....0% Complete"
j = 0
For i = 1 To 4
sStr = RetStr(i)
With Application.FileSearch
.NewSearch
.LookIn = sStr
.SearchSubFolders = False
.Filename = ".xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
If i < 4 Then
For j = 1 To .FoundFiles.Count
Set wkbk =
Workbooks.Open(Filename:=.FoundFiles(j), UpdateLinks:=False,
ReadOnly:=True)
' This deletes the headers and a few columns that
have text in them that I don't want
' It also multiplies the numbers that are in text
format by 1 to turn them back into numbers
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Range("K1").Value = 1
Range("K1").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False

Range("A1").Select
ActiveCell.CurrentRegion.Select
m = Selection.Rows.Count
Range(ActiveCell.Offset(0, 10),
ActiveCell.Offset(m - 1, 10)) = 1
Range("A1").Select
Set rng = ActiveCell.CurrentRegion.Select
' This is where items get loaded into a temp array
(possible issue)
aTemp.Value = rng.Value
' Here's where I use your routine - I think this
is basically tacking on the new query to the bottom
' of the existing one - am I correct in that
assumption ?
ReplaceSubArray aQuery, aTemp, n + 1, 1
' I get all blanks here, so I know something is
wrong.
MsgBox aQuery(n, 5)
n = n + m
ActiveWorkbook.Close ([False])
pct = Round(n / l * 100, 0)
Application.StatusBar = "Loading Queries...." &
pct & "% Complete"
Next
End If
If i = 4 Then
For j = 1 To .FoundFiles.Count
Set wkbk =
Workbooks.Open(Filename:=.FoundFiles(j), UpdateLinks:=False,
ReadOnly:=True)
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("F1").Value = 1
Range("F1").Select
Application.CutCopyMode = False
Selection.Copy
If j = 2 Then
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("D1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Set rng = ActiveCell.CurrentRegion.Select
m = Selection.Rows.Count
ReDim FnAcctDept(m, 3)
FnAcctDept() = rng.Value
n = n + m
ActiveWorkbook.Close ([False])
pct = Round(n / l * 100, 0)
Application.StatusBar = "Loading Queries...."
& pct & "% Complete"
End If
If j = 1 Or j = 3 Or j = 4 Then
Range("A1").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.PasteSpecial
Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.PasteSpecial
Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Set rng =
ActiveCell.CurrentRegion.Select
m = Selection.Rows.Count
If j = 1 Then
ReDim DeptFleet(m, 2)
DeptFleet() = rng.Value
End If
If j = 4 Then
ReDim LocDept(m, 2)
LocDept() = rng.Value
End If
If j = 3 Then
ReDim LocBldg(m, 2)
LocBldg() = rng.Value
End If
n = n + m
ActiveWorkbook.Close ([False])
pct = Round(n / l * 100, 0)
Application.StatusBar = "Loading
Queries...." & pct & "% Complete"
End If
Next
End If
End If
End With
Next
Application.StatusBar = "Performing Test Write"
Workbooks.Add
For i = 1 To 9
Range("A1").Select
Set rng2 = Cells(Rows.Count, 1).End(xlUp)(2)
rng2.Resize(rnglgth(i), 10).Value = aQuery
Sheets.Add
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
UserForm2.Show
End Sub

Thoughts?
 
A

Alan Beban

If my response in your later thread "Writing Range to Array" hasn't
fixed the problem, repost in this thread.

Alan Beban
Well the good news is - the new routines definately sped up the
process (down to a few seconds - which is easily acceptable)

The bad part is that for some reason, when I do a test write out of
the array to a new workbook, I get all blanks, so I must be doing
something wrong (I hope)

Here's my code:

Public RetStr(5) As String
Public fname(70) As String
Public aQuery() As Variant
Public FnAcctDept() As Variant
Public DeptFleet() As Variant
Public LocDept() As Variant
Public LocBldg() As Variant
Public rnglgth() As Variant

Sub FileOpen()
Dim i, j, k, n, o, p As Integer
Dim l, m As Long
Dim pct As Double
Dim sStr, fnStr As String
Dim rng, rng2, c As Range
On Error Resume Next
UserForm3.Hide
Unload UserForm3
Application.ScreenUpdating = False
Application.StatusBar = "Checking For Files...."
j = 0
k = 0
' RetStr(i) is a folder name gathered from another routine - this part
works
For i = 1 To 5
sStr = RetStr(i)
With Application.FileSearch
.NewSearch
.LookIn = sStr
.SearchSubFolders = False
.Filename = ".xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
o = o + .FoundFiles.Count
Application.StatusBar = o & " Files Found..."
' The next section checks if a file that is going to be opened happens
to already be open and closes it
' so that it can be read in read-only mode
If i < 5 Then
For j = 1 To .FoundFiles.Count
k = k + 1
ReDim Preserve rnglgth(k)
If WorkbookIsOpen(.FoundFiles(j)) Then
fnStr = .FoundFiles(j)
Workbooks(fnStr).Activate
ActiveWorkbook.Close ([False])
End If
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(j),
UpdateLinks:=False, ReadOnly:=True)
If i < 4 Then
' Depending on the file, certain rows are headers that I don't want
to count in my row totals
Rows("1:3").Select
Else
Rows("1:1").Select
End If
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveCell.CurrentRegion.Select
rnglgth(k) = Selection.Rows.Count
ActiveWorkbook.Close ([False])
Next
End If
Else
MsgBox "No file found in Folder " & sStr
UserForm3.Show
Exit Sub
End If
End With
Next i
For j = 1 To k
l = l + rnglgth(j)
Next
ReDim aQuery(l, 11)
Application.StatusBar = "Loading Queries....0% Complete"
j = 0
For i = 1 To 4
sStr = RetStr(i)
With Application.FileSearch
.NewSearch
.LookIn = sStr
.SearchSubFolders = False
.Filename = ".xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
If i < 4 Then
For j = 1 To .FoundFiles.Count
Set wkbk =
Workbooks.Open(Filename:=.FoundFiles(j), UpdateLinks:=False,
ReadOnly:=True)
' This deletes the headers and a few columns that
have text in them that I don't want
' It also multiplies the numbers that are in text
format by 1 to turn them back into numbers
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Range("K1").Value = 1
Range("K1").Select
Application.CutCopyMode = False
Selection.Copy
Range("A1").Select
ActiveCell.CurrentRegion.Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False

Range("A1").Select
ActiveCell.CurrentRegion.Select
m = Selection.Rows.Count
Range(ActiveCell.Offset(0, 10),
ActiveCell.Offset(m - 1, 10)) = 1
Range("A1").Select
Set rng = ActiveCell.CurrentRegion.Select
' This is where items get loaded into a temp array
(possible issue)
aTemp.Value = rng.Value
' Here's where I use your routine - I think this
is basically tacking on the new query to the bottom
' of the existing one - am I correct in that
assumption ?
ReplaceSubArray aQuery, aTemp, n + 1, 1
' I get all blanks here, so I know something is
wrong.
MsgBox aQuery(n, 5)
n = n + m
ActiveWorkbook.Close ([False])
pct = Round(n / l * 100, 0)
Application.StatusBar = "Loading Queries...." &
pct & "% Complete"
Next
End If
If i = 4 Then
For j = 1 To .FoundFiles.Count
Set wkbk =
Workbooks.Open(Filename:=.FoundFiles(j), UpdateLinks:=False,
ReadOnly:=True)
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("F1").Value = 1
Range("F1").Select
Application.CutCopyMode = False
Selection.Copy
If j = 2 Then
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("D1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Set rng = ActiveCell.CurrentRegion.Select
m = Selection.Rows.Count
ReDim FnAcctDept(m, 3)
FnAcctDept() = rng.Value
n = n + m
ActiveWorkbook.Close ([False])
pct = Round(n / l * 100, 0)
Application.StatusBar = "Loading Queries...."
& pct & "% Complete"
End If
If j = 1 Or j = 3 Or j = 4 Then
Range("A1").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.PasteSpecial
Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.PasteSpecial
Paste:=xlValues, Operation:=xlMultiply, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Set rng =
ActiveCell.CurrentRegion.Select
m = Selection.Rows.Count
If j = 1 Then
ReDim DeptFleet(m, 2)
DeptFleet() = rng.Value
End If
If j = 4 Then
ReDim LocDept(m, 2)
LocDept() = rng.Value
End If
If j = 3 Then
ReDim LocBldg(m, 2)
LocBldg() = rng.Value
End If
n = n + m
ActiveWorkbook.Close ([False])
pct = Round(n / l * 100, 0)
Application.StatusBar = "Loading
Queries...." & pct & "% Complete"
End If
Next
End If
End If
End With
Next
Application.StatusBar = "Performing Test Write"
Workbooks.Add
For i = 1 To 9
Range("A1").Select
Set rng2 = Cells(Rows.Count, 1).End(xlUp)(2)
rng2.Resize(rnglgth(i), 10).Value = aQuery
Sheets.Add
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
UserForm2.Show
End Sub

Thoughts?
Click to expand...
 
M

Marston

I think its working now - except there is one thing I still haven't
quite figured out yet.

In trying to write out the array (to make sure it was accepted
correctly at this point - in the future - I'll need to sort the array
based on series of parameters (e.g. sort the array aArray(row,
parameter=n1) so that its in order from lowest to highest then within
that sort, sort it based on parameter=n2..etc. where n1 and n2 are
numbers) - then I'll need to write those out to worksheets again - so
the same issue will appear -- and that is

How do I access a portion of the array? In trying to write it out, I
couldn't find a way to write out rows 1- length of all rows read from
first worksheet on to one worksheet, that index + 1 to the length of
all rows read in from second worksheet onto another worksheet, etc.

I have a variable that tells me the rows and columns of each read in
range, I would have thought that there would be some syntax to write
out something like:

Workbooks.Add
totalrow = 0
For i = 1 to filecount
Range("A1").Select
Set rng = Cells(rows.Count,1).End(xlUp) (2)
rng.Resize(rowcount(i),columncount(i)).Value = aArray(totalrow+1 To
totalrow+rowcount(i), 1 to columncount(i))
totalrow = totalrow + rowcount(i)
Sheets.Add
Next i

But obviously my syntax is incorrect....
 
A

Alan Beban

Marston said:
I think its working now - except there is one thing I still haven't
quite figured out yet.

In trying to write out the array (to make sure it was accepted
correctly at this point - in the future - I'll need to sort the array
based on series of parameters (e.g. sort the array aArray(row,
parameter=n1) so that its in order from lowest to highest then within
that sort, sort it based on parameter=n2..etc. where n1 and n2 are
numbers) - then I'll need to write those out to worksheets again - so
the same issue will appear -- and that is

How do I access a portion of the array? In trying to write it out, I
couldn't find a way to write out rows 1- length of all rows read from
first worksheet on to one worksheet, that index + 1 to the length of
all rows read in from second worksheet onto another worksheet, etc.

I have a variable that tells me the rows and columns of each read in
range, I would have thought that there would be some syntax to write
out something like:

Workbooks.Add
totalrow = 0
For i = 1 to filecount
Range("A1").Select
Set rng = Cells(rows.Count,1).End(xlUp) (2)
rng.Resize(rowcount(i),columncount(i)).Value = aArray(totalrow+1 To
totalrow+rowcount(i), 1 to columncount(i))
totalrow = totalrow + rowcount(i)
Sheets.Add
Next i

But obviously my syntax is incorrect....
Click to expand...
If the size of the resized range is the same as that of the array
portion, *and* if you have made available to your worksheet the
functions in the freely downloadable file at
http://home.pacbell.net/beban, then the following:

rng.Resize(rowcount(i),columncount(i)).Value = SubArray(aArray,p,q,r,s)

where p is the starting column number, q is the ending column number, r
is the starting row number and t is the ending row number of the portion
will transfer the portion to the range.

Alan Beban
 
M

Marston

Thanks Alan,

I'll try that in the morning. Believe it or not I spent something like
3 hrs searching through old postings and never found anything that
would help, then just about 10 minutes before your message came
across, I came across another posting that you answered, probably only
a month ago or so to someone where you had him use your SubArray
function. How does that differ from this approach?

Also - I was looking through the code that I downloaded and I see that
there is a sort function there. Is that going to be a good routine for
me to sort things the way I mentioned?

My issue is that when I sort data via 1 column of info in the array, I
want the other items in the same row to move with the column being
sorted.

One other question - how do folks like you and a few of the others I
come across in about a million posting have time for this kind of free
support?

About every 6-9 months I come across a need for VB and I have almost
go back to school on it and re-teach myself how to do things and it
never fails that the nice people such as yourself always come through.
 
A

Alan Beban

Marston said:
Thanks Alan,

I'll try that in the morning. Believe it or not I spent something like
3 hrs searching through old postings and never found anything that
would help, then just about 10 minutes before your message came
across, I came across another posting that you answered, probably only
a month ago or so to someone where you had him use your SubArray
function. How does that differ from this approach?
Click to expand...

I don't have any idea what the context was for the prior post, but the
SubArray function is just a generic function for returning any sub array
from a one- or two-dimensional array.
Also - I was looking through the code that I downloaded and I see that
there is a sort function there. Is that going to be a good routine for
me to sort things the way I mentioned?
Click to expand...

I'm not a good one to respond concerning sorts. It is the first
procedure in the module with all of the procedures in it, so the
Copyright notice is misleading to the extent it suggests that the sort
routine is mine; the notice applies to the entire module and the sort
routine happens to be the first one. It's a QuickSort routine that's
been around for a long time and I don't even recall where I got it. At
the time I included it in the function module it seemed handy.
One other question - how do folks like you and a few of the others I
come across in about a million posting have time for this kind of free
support?
Click to expand...
A few years back I used to post much more than I do now; it's just an
interest that I developed as a dilettante, and following the newsgroups
is a way to keep current in those areas that I developed an interest in,
particularly since I don't learn by professionally programming.

Thanks for the kind words.

Alan Beban
 
M

Marston

Hey - thought you might like to know I figured what I hope will be an
easy way to do my sort. Rather than try to reproduce what the
worksheet sort does to my large array in VB,
I'm going to put down another column of data that effectively is the
value of the concatenation of those items I want to sort on,
concatenated in the order in which I want to sort. I'll have to watch
to make sure that I don't have any leading zeros in any of the fields
to make sure my "number" doesn't shrink creating an improper
comparison variable - but I should be able to quick sort on this value
- and then once sorted, I can eliminate it because I won't need it
anymore....
 
M

Marston

Alan - after fixing a couple of other bugs I had in my code-

I finally was able to write the array back out to worksheets to
validate that
the array was being loaded properly from the original files. So
everything is great.

Now I'm off to try my sorting idea through concatenating various
columns.
 
A

Alan Beban

Marston said:
Alan - after fixing a couple of other bugs I had in my code-

I finally was able to write the array back out to worksheets to
validate that
the array was being loaded properly from the original files. So
everything is great.

Now I'm off to try my sorting idea through concatenating various
columns.
Click to expand...
Thanks for the feedback.

Alan Beban
 
M

Marston

Alan -

I think I have another array problem that is right up your alley.
I tried my sorting technique and in principle, I think it will work.
The problem is when I try to convert the "values" in each of 6 columns
(out of 10) into a single value on which I can then use the Quick
sort, I find that because I end up with a number that can be as high
as 10+e18-1 that even though I dim my variable as double, it loses the
last 3 digits. I think this might be due to a limitation in the # of
bytes of info being stored.

My thought was, I could shrink the "sorting" number substantially if I
could find out how many unique values there are in each of the 6
columns in my array.
I could then transform my values into a smaller set then using my
idea, I should have enough byte space to create a number Quick sort
could use.

I've been looking through your functions and I notice that it appears
you have a function that provides unique values in an array, but I
can't figure out how to feed it just one column from my array. Do I
need to create new arrays with just that 1 column of data? Is there a
fast way to do that?

Do you think you know of a way to make the transformation once I have
a unique set? My problem here is this. Assume that for most of my
columns there are very limited sets of unique values. Most are in the
dozens or less, only one is large (~1600 uniques).

Effectively I think my 6 groups have approximately the following
unique # of entries: 100, 60, 10, 1600, 9, 70

This means I could reduce my 10E+18 -1 range to 1E+12-1 - still a big
number, but from what I've seen doable.

I'd need to loop through the entire array and effectively replace the
existing values with the incremental unique value while I create the
"combo" number, then put them back. Then I'd create a 2d array that
would hold the "combo" number for each row in the array and the row
number. Once its sorted on the combo value, I could reference the row
number to rearrange the original array the way it should be.

But as I've said, I don't know how to pass each of the 6 columns in my
array to your function to come up with the unique arrays and the
compare those values to those in the original array.
 
A

Alan Beban

As for ArrayUniques, there are two problems. One, it has a bug in it if
it is not called from the worksheet; two, it's really slow. I will, now
that I discovered the bug, fix it; but in the meantime you might post
asking for VBA code to extract unique values from an Nx1 array. A
number of routines have been suggested over time.

Alan Beban
 
M

Marston

Write not working now....I think its not loading into aTemp (the
subarray I use to build the total array aArray)

I did something, but I can't figure out what. Here's a simplified
version

Sub Routine()
Dim i,j,k,maxparams As Integer
Dim entries() As Variant
Dim parameters() As Variant
Dim cumentries() As Variant
Dim wkbk As Workbook
k = 0
cumentries(0) = 0
maxparams = 0
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = sStr
.SearchSubFolder = False
.Filename = ".xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
nFiles = .FoundFiles.Count
For j = 1 To .FoundFiles.Count
k = k + 1
Redim Preserve entries(k)
Redim Preserve parameters(k)
Redim Preserve cumentries(k)
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(j),UpdateLinks:=False,ReadOnly:=True
Range("A1").CurrentRegion.Select
entries(k) = Selection.Rows.Count
If k = 1 Then
cumentries(k) = entries
Else
cumentries(k) = cumentries(k-1) + entries(k)
End If
parameters(k) = Selection.Columns.Count
If parameters(k) > maxparams Then
maxparams = parameters(k)
End If
Else
Exit Sub
End If
End With
ReDim aArray(cumentries(k),maxparams)
k = 0
For j = 1 to .FoundFiles.Count
k = k +1
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(j),),UpdateLinks:=False,ReadOnly:=True
Set rng = Range("A1").CurrentRegion.Select
aTemp = rng.Value
ReplaceSubArray aArray, aTemp, entries(j-1)+1,1
Next j
ActiveWorkBook.Close([False])
Sheets.Add
For i = 1 to nFile
Set rng = Range("A1").Range(Cells(1,1),Cells(entries(i),parameters(i)))
rng.Resize(entries(i),parameters(i)).Value =
SubArray(aArray,1,parameters(i),cummentries(i-1),cumentries(i)
Sheets.Add
Next i
End Sub
 
Top