Delete empty array columns

R

RB Smissaert

I needed a function to delete columns of a VBA array where all the elements
were empty.
By deleting I mean something similar as deleting columns in a sheet where
the columns move to the left.
I couldn't find such a function, so I wrote one.
As somebody may know a better one (in that case please let me know) or
somebody might find this
function useful I post it here.


Function DeleteEmptyArrayColumns(ByRef arr As Variant) As Variant

'moves data to the left if a column holds no data
'redims the final array so that no empty columns are left on the right
'---------------------------------------------------------------------

Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim i As Long
Dim c As Long
Dim c2 As Long
Dim markingArray As Variant
Dim arr2 As Variant
Dim lEmptyCount As Long
Dim lGetCopyCol As Long

LB1 = LBound(arr, 1)
LB2 = LBound(arr, 2)
UB1 = UBound(arr, 1)
UB2 = UBound(arr, 2)

'array to keep track of empty columns
'------------------------------------
ReDim markingArray(LB2 To UB2)

'fill markingArray with zero's (nil empty column found yet)
'----------------------------------------------------------
For c = LB2 To UB2
markingArray(c) = 0
Next

For c = LB2 To UB2
For i = LB1 To UB1
If Len(arr(i, c)) > 0 Then
'found data, so move to next column
'----------------------------------
Exit For
End If
If i = UB1 Then
'found empty column, so mark it
'------------------------------
markingArray(c) = 1
lEmptyCount = lEmptyCount + 1
End If
Next
Next

If lEmptyCount = 0 Then
'no empty columns found, so just return the original array
'---------------------------------------------------------
DeleteEmptyArrayColumns = arr
Exit Function
End If

'prepare the new array to get the non-empty columns
'--------------------------------------------------
ReDim arr2(LB1 To UB1, LB2 To UB2 - lEmptyCount)

'starting column in arr2 to get copies from arr
'----------------------------------------------
lGetCopyCol = LB2

For c = LB2 To UB2
If markingArray(c) = 0 Then
'non-empty column so copy to arr2
'--------------------------------
For i = LB1 To UB1
arr2(i, lGetCopyCol) = arr(i, c)
Next
'set next column to copy to
'--------------------------
lGetCopyCol = lGetCopyCol + 1
End If
Next

DeleteEmptyArrayColumns = arr2

End Function



RBS
 
R

RB Smissaert

One correction:

Have to exit when all the columns only hold empty elements:

If lEmptyCount = 0 Or lEmptyCount = UB2 Then
'no empty columns found or all empty columns found,
'so just return the original array
'-------------------------------------------------
DeleteEmptyArrayColumns = arr
Exit Function
End If


RBS
 
A

Alan Beban

RB said:
I needed a function to delete columns of a VBA array where all the elements
were empty.
By deleting I mean something similar as deleting columns in a sheet where
the columns move to the left.
I couldn't find such a function, so I wrote one.
As somebody may know a better one (in that case please let me know) or
somebody might find this
function useful I post it here. . . .
Click to expand...
Hi RB,

I'm studying the function in xl2000. The first change I made was to the
declaration of markingArray:

Dim markingArray() As Integer

Because markingArray is then initiated with all zeroes, I eliminated the
first loop

For c = LB2 to UB2
markingArray(c) = 0
Next

I'm still studying it.

Alan Beban
 
A

Alan Beban

RB said:
One correction:

Have to exit when all the columns only hold empty elements:

If lEmptyCount = 0 Or lEmptyCount = UB2 Then
'no empty columns found or all empty columns found,
'so just return the original array
'-------------------------------------------------
DeleteEmptyArrayColumns = arr
Exit Function
End If


RBS
Click to expand...
I think the first loop (after deletion of the originally posted first
loop) could be simplified without loss of execution speed:

For c = LB2 To UB2
For i = LBound(arr) To UBound(arr)
k = k + Len(arr(i, c))
Next
If k = 0 Then
'found empty column, so mark it
'------------------------------
markingArray(c) = 1
lEmptyCount = lEmptyCount + 1
End If
Next

Alan Beban
 
A

Alan Beban

Alan said:
I think the first loop (after deletion of the originally posted first
loop) could be simplified without loss of execution speed:

For c = LB2 To UB2
For i = LBound(arr) To UBound(arr)
k = k + Len(arr(i, c))
Next
If k = 0 Then
'found empty column, so mark it
'------------------------------
markingArray(c) = 1
lEmptyCount = lEmptyCount + 1
End If
Next

Alan Beban
Click to expand...
I withdraw the above suggestion. I tested it only on a small array and
thus saw no significant change in speed as it unnecessarily looped
through every row of the non-empty columns.

Alan Beban
 
R

RB Smissaert

Alan,

I can't see much room for improvement with the function as I have it
currently:

Function DeleteEmptyArrayColumns(ByRef arr As Variant) As Variant

'moves data to the left if a column holds no data
'redims the final array so that no empty columns are left on the right
'will just return the original array if all the elements in all columsns
'are empty or if all the columns hold at least one non-empty element
'-----------------------------------------------------------------------

Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim i As Long
Dim c As Long
Dim markingArray() As Integer
Dim arr2 As Variant
Dim lDataCount As Long
Dim lGetCopyCol As Long

LB1 = LBound(arr, 1)
LB2 = LBound(arr, 2)
UB1 = UBound(arr, 1)
UB2 = UBound(arr, 2)

'array to keep track of empty columns
'as it has been declared as integer all the elements
'will have a zero before getting a value
'---------------------------------------------------
ReDim markingArray(LB2 To UB2) As Integer

For c = LB2 To UB2
For i = LB1 To UB1
If Len(Trim(arr(i, c))) > 0 Then
'found data, so mark it, increase the count and move to next
column

'------------------------------------------------------------------
markingArray(c) = 1
lDataCount = lDataCount + 1
Exit For
End If
Next
Next

If lDataCount = 0 Or lDataCount = UB2 Then
'only empty columns found or no empty columns found,
'so just return the original array and exit
'--------------------------------------------------
DeleteEmptyArrayColumns = arr
Exit Function
End If

'prepare the new array to get the non-empty columns
'--------------------------------------------------
ReDim arr2(LB1 To UB1, LB2 To lDataCount - (1 - LB2))

'starting column in arr2 to get copies from arr
'----------------------------------------------
lGetCopyCol = LB2

For c = LB2 To UB2
If markingArray(c) = 1 Then
'non-empty column so copy to arr2
'--------------------------------
For i = LB1 To UB1
arr2(i, lGetCopyCol) = arr(i, c)
Next
'set next column to copy to
'--------------------------
lGetCopyCol = lGetCopyCol + 1
End If
Next

DeleteEmptyArrayColumns = arr2

End Function

I haven't tested for speed, but the only line I could think of that could be
made faster is:

If Len(Trim(arr(i, c))) > 0 Then

I need the trim for my particular purpose, but maybe:

If Not Trim(arr(i, c)) = Empty Then

is faster.
Will test and let you know.


RBS
 
H

Harlan Grove

RB Smissaert said:
I can't see much room for improvement with the function as I have it
currently:
Click to expand...
....

There are a few things you could do differently. An alternative,


Function deca2(ByRef a As Variant) As Variant
Dim i As Long, j As Long, k As Long, n As Long
Dim rl As Long, ru As Long, cl As Long, cu As Long
Dim ne() As Long
Dim rv As Variant

rl = LBound(a, 1)
ru = UBound(a, 1)
cl = LBound(a, 2)
cu = UBound(a, 2)

n = cu - cl + 1
ReDim ne(1 To n) '** 1-based indexing for the column state array

k = 0
For j = cl To cu
For i = rl To ru
If Trim(a(i, j)) <> "" Then '** string comp vs Len call
k = k + 1
ne(k) = j '** record the k_th nonempty column index
Exit For
End If
Next i
Next j

If k = 0 Or k = n Then
deca2 = a
Exit Function
End If

cu = cl + k - 1 '** revise cu
ReDim rv(rl To ru, cl To cu)

n = cl
For j = 1 To cu
k = ne(j) '** use the stored j_th nonempty column index
For i = rl To ru
rv(i, n) = a(i, k)
Next i
n = n + 1
Next j

deca2 = rv
End Function
 
R

RB Smissaert

Thanks for that.
I presume this will give the same result but makes it faster.
Did you test for speed and if so what roughly was the difference?

RBS
 
H

Harlan Grove

RB Smissaert said:
I presume this will give the same result but makes it faster.
Did you test for speed and if so what roughly was the difference?
Click to expand...

It's about 10% faster on average, but both are quite fast.
 
A

Alan Beban

I believe that Harlan Grove's function below, as well as Bart
Smissaert's last posted one, has a problem with 0-based arrays. I think
the problem resides, in Harlan Grove's, in

n = cu - cl + 1

but the fix wasn't obvious to me.

In Bart Smissaert's the fix seems to be in changing

If lDataCount = 0 Or lDataCount = UB2 to

If lDataCount = 0 Or lDataCount = UB2 - LB2 + 1

*But* each should probably be more thoroughly tested.

Alan Beban
 
R

RB Smissaert

Alan,

Yes, that was a bug indeed.
I had taken the 0-based and 1-based difference into acount further on in the
function, but had forgotten with this marking array.
For clarity I would do:

If lDataCount = 0 Or lDataCount = UB2 + (1 - LB2) Then
'only empty columns found or no empty columns found,
'so just return the original array and exit
'--------------------------------------------------
DeleteEmptyArrayColumns = arr
Exit Function
End If


RBS
 
R

RB Smissaert

Harlan,


Firstly, there is one bug in your function.
Your outer loop for copying the columns is now:
For j = 1 To cu
but this should be
For j = 1 To cu + (1 - cl)
Otherwise it will miss out 1 cycle with 0-based arrays.
I had made a similar mistake when redimming the marking array, as Alan
pointed out.
Secondly, I find the speed difference less, about 1 percent.
Again this will depend on the array of course.
Thirdly, there is one way to speed this function up and that is to retain
the row in the column where
the first data was found. This means you can start copying from this row on
and avoid copying empty
elements.

This is what I have now:


Function DeleteEmptyArrayColumns2(ByRef arr As Variant) As Variant

'moves data to the left if a column holds no data
'redims the final array so that no empty columns are left on the right
'will just return the original array if all the elements in all columsns
'are empty or if all the columns hold at least one non-empty element
'-----------------------------------------------------------------------

Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim i As Long
Dim c As Long
Dim markingArray() As Variant
Dim arr2 As Variant
Dim lDataCount As Long
Dim lGetCopyCol As Long

LB1 = LBound(arr, 1)
LB2 = LBound(arr, 2)
UB1 = UBound(arr, 1)
UB2 = UBound(arr, 2)

'array to keep track of non-empty columns
'also keeps track of the first row in that column that has data
'elements will be empty at start, but will:
'get a zero if the first row has data in an 0-based array
'get a 1 if first row has data in a 1-based array
'---------------------------------------------------------------
ReDim markingArray(LB2 To UB2) As Variant

For c = LB2 To UB2
For i = LB1 To UB1
If Trim(arr(i, c)) <> "" Then
'found data, so mark it, increase the count and move to next
column

'------------------------------------------------------------------
markingArray(c) = i
lDataCount = lDataCount + 1
Exit For
End If
Next
Next

If lDataCount = 0 Or lDataCount = UB2 + (1 - LB2) Then
'only empty columns found or no empty columns found,
'so just return the original array and exit
'--------------------------------------------------
DeleteEmptyArrayColumns2 = arr
Exit Function
End If

'prepare the new array to get the non-empty columns
'--------------------------------------------------
ReDim arr2(LB1 To UB1, LB2 To lDataCount - (1 - LB2))

'starting column in arr2 to get copies from arr
'----------------------------------------------
lGetCopyCol = LB2

For c = LB2 To UB2
If Not markingArray(c) = "" Then
'non-empty column so copy to arr2
'start copying at the first row with data
'----------------------------------------
For i = markingArray(c) To UB1
arr2(i, lGetCopyCol) = arr(i, c)
Next
'set next column to copy to
'--------------------------
lGetCopyCol = lGetCopyCol + 1
End If
Next

DeleteEmptyArrayColumns2 = arr2

End Function

Just one question.
I noticed you use very short variables, which makes reading the function
more difficult.
Is this just a personal style or would there be some (very small) speed
advantage in doing this?
My guess is not as I would think that it gets compiled (or should I say made
into p-code?) the same.


RBS
 
H

Harlan Grove

Alan Beban said:
I believe that Harlan Grove's function below, as well as Bart
Smissaert's last posted one, has a problem with 0-based arrays. I think
the problem resides, in Harlan Grove's, in

n = cu - cl + 1
Click to expand...

You're right about a bug existing, but wrong about its cause.

This statement is not an error. Even for 0-based arrays, the number of
elements in any dimension is

ubound - lbound + 1

a(0 To 5) has 6 elements, ubound - lbound + 1 = 5 - 0 + 1 = 6
a(1 To 5) has 5 elements, ubound - lbound + 1 = 5 - 1 + 1 = 5
a(-10 To 10) has 21 elements, ubound - lbound + 1 = 10 - (-10) + 1 = 21
a(0 To 0) has 1 element, ubound - lbound + 1 = 0 - 0 + 1 = 1

Need I go on?
but the fix wasn't obvious to me.
Click to expand...

Because you misdiagnosed the problem.
Harlan Grove wrote: ....
Click to expand...
....

This is where the bug is. k shouldn't be reused as a variable, but should be
used as the iteration bound instead of cu.


Function deca2(ByRef a As Variant) As Variant
'**!!** rev 1: fixed error in final loop over rv columns

Dim i As Long, j As Long, k As Long, n As Long
Dim rl As Long, ru As Long, cl As Long, cu As Long
Dim ne() As Long
Dim rv As Variant

rl = LBound(a, 1)
ru = UBound(a, 1)
cl = LBound(a, 2)
cu = UBound(a, 2)

n = cu - cl + 1
ReDim ne(1 To n) '** 1-based indexing for the column state array

k = 0
For j = cl To cu
For i = rl To ru
If Trim(a(i, j)) <> "" Then '** string comp vs Len call
k = k + 1
ne(k) = j '** record the k_th nonempty column index
Exit For
End If
Next i
Next j

If k = 0 Or k = n Then
deca2 = a
Exit Function
End If

'**!!** no reason to screw around with cu
ReDim rv(rl To ru, cl To cl + k - 1)

For j = 1 To k
n = ne(j) '** use the stored j_th nonempty column index
For i = rl To ru
rv(i, cl) = a(i, n)
Next i
cl = cl + 1 '**!!** just use cl to iterate over rv columns
Next j

deca2 = rv
End Function
 
A

Alan Beban

Harlan said:
You're right about a bug existing, but wrong about its cause.

This statement is not an error. Even for 0-based arrays, the number of
elements in any dimension is

ubound - lbound + 1

a(0 To 5) has 6 elements, ubound - lbound + 1 = 5 - 0 + 1 = 6
a(1 To 5) has 5 elements, ubound - lbound + 1 = 5 - 1 + 1 = 5
a(-10 To 10) has 21 elements, ubound - lbound + 1 = 10 - (-10) + 1 = 21
a(0 To 0) has 1 element, ubound - lbound + 1 = 0 - 0 + 1 = 1

Need I go on?
Click to expand...
Only if you think that by ranting on you'll distract us from the fact
that you're being marvelously pompous about having provided the buggy
code in the first place, along with a questionable claim about a 10%
speed advantage.

Alan Beban
 
H

Harlan Grove

Alan Beban said:
Harlan Grove wrote: ....

Only if you think that by ranting on you'll distract us from the fact
that you're being marvelously pompous about having provided the buggy
code in the first place, along with a questionable claim about a 10%
speed advantage.
Click to expand...

Apparently I did need to go on because you just don't recognize a basic
identity when you see one.

As for buggy code, are you claiming you've never posted any buggy code here?
Want me to provide some google urls pointing out a few? Bugs happen.

Finally, you can test execution times for mine, the OPs and anything your
little mind can dream up too. After more testing, it seems the timing
difference depends on the number of columns in the original array and the
number of blank columns. If there are no blank columns, my udf is slower
than the OP's (not a case I had tested before), if they're all but one
blank, mine is more than 10% faster. But don't take my word for it, test it.

If you still haven't figured out how to benchmark, here's my test harness.
Note that I changed the OP's function name and incorporated his/her 0-based
array fix.


Option Explicit


Function deca1(ByRef arr As Variant) As Variant
'moves data to the left if a column holds no data
'redims the final array so that no empty columns are left on the right
'will just return the original array if all the elements in all columsns
'are empty or if all the columns hold at least one non-empty element
'-----------------------------------------------------------------------
Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim i As Long
Dim c As Long
Dim markingArray() As Integer
Dim arr2 As Variant
Dim lDataCount As Long
Dim lGetCopyCol As Long

LB1 = LBound(arr, 1)
LB2 = LBound(arr, 2)
UB1 = UBound(arr, 1)
UB2 = UBound(arr, 2)

'array to keep track of empty columns
'as it has been declared as integer all the elements
'will have a zero before getting a value
'---------------------------------------------------
ReDim markingArray(LB2 To UB2) As Integer

For c = LB2 To UB2
For i = LB1 To UB1
If Len(Trim(arr(i, c))) > 0 Then
'found data, so mark it, increase the count and move
'to next Column
'---------------------------------------------------
markingArray(c) = 1
lDataCount = lDataCount + 1
Exit For
End If
Next
Next

If lDataCount = 0 Or lDataCount = UB2 + (1 - LB2) Then
'only empty columns found or no empty columns found,
'so just return the original array and exit
'--------------------------------------------------
deca1 = arr
Exit Function
End If

'prepare the new array to get the non-empty columns
'--------------------------------------------------
ReDim arr2(LB1 To UB1, LB2 To lDataCount - (1 - LB2))

'starting column in arr2 to get copies from arr
'----------------------------------------------
lGetCopyCol = LB2

For c = LB2 To UB2
If markingArray(c) = 1 Then
'non-empty column so copy to arr2
'--------------------------------
For i = LB1 To UB1
arr2(i, lGetCopyCol) = arr(i, c)
Next
'set next column to copy to
'--------------------------
lGetCopyCol = lGetCopyCol + 1
End If
Next

deca1 = arr2

End Function


Function deca2(ByRef a As Variant) As Variant
Dim i As Long, j As Long, k As Long, n As Long
Dim rl As Long, ru As Long, cl As Long, cu As Long
Dim ne() As Long
Dim rv As Variant

rl = LBound(a, 1)
ru = UBound(a, 1)
cl = LBound(a, 2)
cu = UBound(a, 2)

n = cu - cl + 1
ReDim ne(1 To n)

k = 0
For j = cl To cu
For i = rl To ru
If a(i, j) Like "*[^ ]*" Then
k = k + 1
ne(k) = j
Exit For
End If
Next i
Next j

If k = 0 Or k = n Then
deca2 = a
Exit Function
End If

cu = cl + k - 1
ReDim rv(rl To ru, cl To cu)

For j = 1 To k
n = ne(j)
For i = rl To ru
rv(i, cl) = a(i, n)
Next i
cl = cl + 1
Next j

deca2 = rv
End Function


Sub testem()
Const MAXITER As Long = 10000

Dim a As Variant, b As Variant
Dim inct As Double, cumt As Double, n As Long

a = mkfoo(10, 20, 12)

cumt = 0
For n = 1 To MAXITER
inct = Timer
b = deca1(a)
cumt = cumt + Timer - inct
Erase b
Next n
Debug.Print "deca1: " & Format(cumt, "0.00")

cumt = 0
For n = 1 To MAXITER
inct = Timer
b = deca2(a)
cumt = cumt + Timer - inct
Erase b
Next n
Debug.Print "deca2: " & Format(cumt, "0.00")

Debug.Print String(30, "-")
End Sub


Function mkfoo(rs As Long, cs As Long, n As Long) As Variant
Dim i As Long, j As Long
Dim rv As Variant

ReDim rv(0 To rs - 1, 0 To cs - 1)

For i = 0 To rs - 1
For j = 0 To cs - 1
rv(i, j) = i & " " & j
Next j
Next i

If n > cs Then n = cs - 1

Do While n > 0
j = Int(12 * Rnd)
For i = 0 To rs - 1
rv(i, j) = ""
Next i
n = n - 1
Loop

mkfoo = rv
End Function
 
R

RB Smissaert

The arrays I am dealing with usually have no or few empty columns and that
is what I tested with. This is probably why I didn't get the 10% speed
improvement.
What does make a difference though is to retain the row numbers of the rows
where
the first data is found as shown in the function I posted 20/8/04. As this
number
is available at no extra cost it might as well be used.

RBS


Harlan Grove said:
Alan Beban said:
Harlan Grove wrote: ...

Only if you think that by ranting on you'll distract us from the fact
that you're being marvelously pompous about having provided the buggy
code in the first place, along with a questionable claim about a 10%
speed advantage.
Click to expand...

Apparently I did need to go on because you just don't recognize a basic
identity when you see one.

As for buggy code, are you claiming you've never posted any buggy code here?
Want me to provide some google urls pointing out a few? Bugs happen.

Finally, you can test execution times for mine, the OPs and anything your
little mind can dream up too. After more testing, it seems the timing
difference depends on the number of columns in the original array and the
number of blank columns. If there are no blank columns, my udf is slower
than the OP's (not a case I had tested before), if they're all but one
blank, mine is more than 10% faster. But don't take my word for it, test it.

If you still haven't figured out how to benchmark, here's my test harness.
Note that I changed the OP's function name and incorporated his/her 0-based
array fix.


Option Explicit


Function deca1(ByRef arr As Variant) As Variant
'moves data to the left if a column holds no data
'redims the final array so that no empty columns are left on the right
'will just return the original array if all the elements in all columsns
'are empty or if all the columns hold at least one non-empty element
'-----------------------------------------------------------------------
Dim LB1 As Byte
Dim LB2 As Byte
Dim UB1 As Long
Dim UB2 As Long
Dim i As Long
Dim c As Long
Dim markingArray() As Integer
Dim arr2 As Variant
Dim lDataCount As Long
Dim lGetCopyCol As Long

LB1 = LBound(arr, 1)
LB2 = LBound(arr, 2)
UB1 = UBound(arr, 1)
UB2 = UBound(arr, 2)

'array to keep track of empty columns
'as it has been declared as integer all the elements
'will have a zero before getting a value
'---------------------------------------------------
ReDim markingArray(LB2 To UB2) As Integer

For c = LB2 To UB2
For i = LB1 To UB1
If Len(Trim(arr(i, c))) > 0 Then
'found data, so mark it, increase the count and move
'to next Column
'---------------------------------------------------
markingArray(c) = 1
lDataCount = lDataCount + 1
Exit For
End If
Next
Next

If lDataCount = 0 Or lDataCount = UB2 + (1 - LB2) Then
'only empty columns found or no empty columns found,
'so just return the original array and exit
'--------------------------------------------------
deca1 = arr
Exit Function
End If

'prepare the new array to get the non-empty columns
'--------------------------------------------------
ReDim arr2(LB1 To UB1, LB2 To lDataCount - (1 - LB2))

'starting column in arr2 to get copies from arr
'----------------------------------------------
lGetCopyCol = LB2

For c = LB2 To UB2
If markingArray(c) = 1 Then
'non-empty column so copy to arr2
'--------------------------------
For i = LB1 To UB1
arr2(i, lGetCopyCol) = arr(i, c)
Next
'set next column to copy to
'--------------------------
lGetCopyCol = lGetCopyCol + 1
End If
Next

deca1 = arr2

End Function


Function deca2(ByRef a As Variant) As Variant
Dim i As Long, j As Long, k As Long, n As Long
Dim rl As Long, ru As Long, cl As Long, cu As Long
Dim ne() As Long
Dim rv As Variant

rl = LBound(a, 1)
ru = UBound(a, 1)
cl = LBound(a, 2)
cu = UBound(a, 2)

n = cu - cl + 1
ReDim ne(1 To n)

k = 0
For j = cl To cu
For i = rl To ru
If a(i, j) Like "*[^ ]*" Then
k = k + 1
ne(k) = j
Exit For
End If
Next i
Next j

If k = 0 Or k = n Then
deca2 = a
Exit Function
End If

cu = cl + k - 1
ReDim rv(rl To ru, cl To cu)

For j = 1 To k
n = ne(j)
For i = rl To ru
rv(i, cl) = a(i, n)
Next i
cl = cl + 1
Next j

deca2 = rv
End Function


Sub testem()
Const MAXITER As Long = 10000

Dim a As Variant, b As Variant
Dim inct As Double, cumt As Double, n As Long

a = mkfoo(10, 20, 12)

cumt = 0
For n = 1 To MAXITER
inct = Timer
b = deca1(a)
cumt = cumt + Timer - inct
Erase b
Next n
Debug.Print "deca1: " & Format(cumt, "0.00")

cumt = 0
For n = 1 To MAXITER
inct = Timer
b = deca2(a)
cumt = cumt + Timer - inct
Erase b
Next n
Debug.Print "deca2: " & Format(cumt, "0.00")

Debug.Print String(30, "-")
End Sub


Function mkfoo(rs As Long, cs As Long, n As Long) As Variant
Dim i As Long, j As Long
Dim rv As Variant

ReDim rv(0 To rs - 1, 0 To cs - 1)

For i = 0 To rs - 1
For j = 0 To cs - 1
rv(i, j) = i & " " & j
Next j
Next i

If n > cs Then n = cs - 1

Do While n > 0
j = Int(12 * Rnd)
For i = 0 To rs - 1
rv(i, j) = ""
Next i
n = n - 1
Loop

mkfoo = rv
End Function
Click to expand...
 
A

Alan Beban

Harlan said:
. . .
As for buggy code, are you claiming you've never posted any buggy code here?
Click to expand...

No, not at all. Just that *you're* overly pompous about it, even for
you, when *you* do.

Alan Beban
 
A

Alan Beban

Harlan said:
...
As for buggy code, are you claiming you've never posted any buggy code here?
Want me to provide some google urls pointing out a few?
. . .
Click to expand...

Hey, if it's important to you, knock yourself out.

Alan Beban
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Array +fonction+vba 1
populating listview with array 2
Baffled with assignment of range to array why won't it work??? Anyhelp appreciated 4
separate multiline address into separate columns 3
Access Access Table Array 1
Application.Index & Application.Match 8
Read a range into an array 9
Subject: Type 13 Error when defining a Columns variable 2

Top