Problem transferring array data onto worksheet using Resize

[Ken Johnson]

I'm trying to use a technique of speeding up code by transferring the
data to VBA array(s), processing the array(s) then transferring the
processed data back to the worksheet.
When I type the example code from John Green's "Excel 2000 VBA
PROGRAMMER'S REFERENCE" (p155) into my VBA Editor and run it on a
Worksheet with "Kee" in some of the rows of column B and numbers in
Column F it works perfectly, producing discount figures in column G in
rows that have "Kee" in column B.
John Green's code follows:

Public Sub KeeDiscount()
Dim vaSalesData As Variant
Dim vaDiscount() As Variant
Dim i As Long

vaSalesData = Range("A2:F73").Value
ReDim vaDiscount(1 To UBound(vaSalesData, 1), 1 To 1)
For i = 1 To UBound(vaSalesData, 1)
If vaSalesData(i, 2) = "Kee" Then
vaDiscount(i, 1) = vaSalesData(i, 6) * 0.1
End If
Next i
Range("G2").Resize(UBound(vaSalesData, 1), 1).Value = vaDiscount
End Sub

When I try to use this technique my processed data is not being
transferred back to the worksheet. What on Earth am I doing wrong?

My workbook has two sheets. Sheet1 has a list of words in column A,
starting at A2, directly below the heading List1 in A1.There are no
blank cells in the list.
Sheet2 has a list of words in Column A, starting at A2, directly below
the heading List2 in A1.There are no blank rows there either.
Some of the words in List2 are also in List1 on Sheet1.
All I want my code to do is place into column B of Sheet1 a list of all
the words from List2 (Column A, Sheet2) that are not in List1 (Column
A, Sheet1). The only part of my code that is refusing to work is the
last line, where I am wanting to Resize Range B2 on Sheet1 to the
correct size for accepting all of the processed array data in
vaUniques.

My Code follows:


Public Sub List1_Not_On_List2()
Dim vaList1 As Variant, vaList2 As Variant, vaUniques() As Variant
Dim I As Long, J As Long, K As Long
Dim List1Rows As Long, List2Rows As Long
List1Rows = Application.CountA(Sheet1.Range("A2:A65536"))
List2Rows = Application.CountA(Sheet2.Range("A2:A65536"))
With Sheet1
vaList1 = .Range(.Cells(2, 1), .Cells(List1Rows + 1, 1)).Value
End With
With Sheet2
vaList2 = .Range(.Cells(2, 1), .Cells(List2Rows + 1, 1)).Value
End With
For I = 1 To UBound(vaList1)
For J = 1 To UBound(vaList2)
If vaList1(I, 1) = vaList2(J, 1) Then
Let vaList2(J, 1) = ""
End If
Next J
Next I
For I = 1 To UBound(vaList2)
If vaList2(I, 1) <> "" Then
Let K = K + 1
ReDim Preserve vaUniques(K)
Let vaUniques(K) = vaList2(I, 1)
End If
Next I
Sheet1.Range("B2").Resize(UBound(vaUniques, 1), 1).Value = vaUniques
End Sub

Can anybody see what I'm doing wrong?
I'm not wanting another method, I just want this Resize to work the way
it works for John Green. To date I've had to resort to using a loop to
get the data onto the worksheet. John's technique gets the data in
place in one fell swoop.

Ken Johnson

 

[Toppers]

Ken,

I could only get it to work by Redim of VaUniques before assigning
data (as per John Green's example) rather than using Redim Preserve.

HTH

Public Sub List1_Not_On_List2()
Dim vaList1 As Variant, vaList2 As Variant, vaUniques() As Variant
Dim I As Long, J As Long, K As Long
Dim List1Rows As Long, List2Rows As Long
List1Rows = Application.CountA(Sheet1.Range("A2:A65536"))
List2Rows = Application.CountA(Sheet2.Range("A2:A65536"))
With Sheet1
vaList1 = .Range(.Cells(2, 1), .Cells(List1Rows + 1, 1)).Value
End With
With Sheet2
vaList2 = .Range(.Cells(2, 1), .Cells(List2Rows + 1, 1)).Value
End With
For I = 1 To UBound(vaList1)
For J = 1 To UBound(vaList2)
If vaList1(I, 1) = vaList2(J, 1) Then
Let vaList2(J, 1) = ""
End If
Next J
Next I
K = 0
ReDim vaUniques(1 To UBound(vaList2, 1), 1 To 1)
For I = 1 To UBound(vaList2)
If vaList2(I, 1) <> "" Then
K = K + 1
vaUniques(K, 1) = vaList2(I, 1)
End If
Next I

Sheet1.Range("B2").Resize(UBound(vaUniques, 1), 1).Value = vaUniques

End Sub

 

[Ken Johnson]

Hi Toppers,
You're a genius!
Sure is weird that an array that has been progressively redimensioned
and preserved could not be transferred back to the worksheet.
I'll just have to commit this to memory.
Thanks Again.
Ken Johnson

 

[DM Unseen]

You can only preserve an array while changing the *last* dimension. If
you change any other dimension, preserving the array data is not
allowed.

DM Unseen

 

[Ken Johnson]

Hi DM Unseen,

The last dimension is the columns dimension and I now see that it was
the rows, or first dimension that I was trying to redimension and
preserve, which is not possible, as you have pointed out.
Another way of looking at it is that the vaUniques array that I was
trying to transfer back to the worksheet was not a two dimensional
array and therefore lacked the second dimension that would give it the
rows/columns structure required for the transfer.

Thanks for your help, my code is now 6% faster than it was when
transferring with a loop.

Ken Johnson

 

[DM Unseen]

Ken,

a formula only solution can be found at
http://www.cpearson.com/excel/duplicat.htm

You can even use this solution in VBA

Sub t()

Dim rngOrginalList As Range, rngCell As Range, rngCompareList As Range
Dim strListAddress As String, strCellAddress As String, i As Integer
Dim List1Rows As Long, List2Rows As Long
Dim rngList1 As Range, rngList2 As Range
Dim varItems() As Variant
Dim strFormula As String
Dim varItem As Variant

Set rngList1 = Sheet1.Range("A2:A65536")
Set rngList2 = Sheet2.Range("A2:A65536")

List1Rows = Application.CountA(rngList1)
List2Rows = Application.CountA(rngList2)

Set rngList1 = rngList1.Resize(List1Rows)

Set rngList2 = rngList2.Resize(List2Rows)

If List1Rows > List2Rows Then
Set rngOrginalList = rngList1
Set rngCompareList = rngList2
ReDim varItems(1 To List1Rows)

Else
Set rngOrginalList = rngList2
Set rngCompareList = rngList1
ReDim varItems(1 To List2Rows)
End If
strListAddress = rngCompareList.Address(, , , True)

i = 1
For Each rngCell In rngOrginalList
strCellAddress = rngCell.Address(, , , True)
strFormula = "=IF(COUNTIF(" & strListAddress & "," & strCellAddress
& ")=0," & strCellAddress & ","""")"
varItem = Application.Evaluate(strFormula)
If Len(varItem) > 0 Then
varItems(i) = varItem
i = i + 1
End If
'If varItems(i) = vbNullString Then Exit For
Next rngCell

redim preserve varItems(1 to i-1)

End Sub

Note that I just build a simple array here!
This code can be further optimized, but it should be pretty fast
already!

Dm Unseen

 

[Alan Beban]

Hi DM Unseen,

The last dimension is the columns dimension and I now see that it was
the rows, or first dimension that I was trying to redimension and
preserve, which is not possible, as you have pointed out.
Another way of looking at it is that the vaUniques array that I was
trying to transfer back to the worksheet was not a two dimensional
array and therefore lacked the second dimension that would give it the
rows/columns structure required for the transfer.

Thanks for your help, my code is now 6% faster than it was when
transferring with a loop.

Ken Johnson

I didn't follow all of the discussion, but for what it's worth, a
one-dimensional array can be readily transferred to a worksheet. A
one-dimensional array has as much "rows/columns structure" as a one-row
range on a worksheet.

And as an aside, if the functions in the freely downloadable file at
http://home.pacbell.net/beban are available to your workbook, you might
want to review the ArrayResize function, which avoids the limitation of
working on only the last dimension of an array.

Alan Beban

 

[Ken Johnson]

Hi Alan,
It just looks to me like the way I set up my vaUniques array with just
the one index variable as in vaUniques(n) rather than with two as in
vaUniques (n,1) that this results in Excel not transferring the data to
the worksheet using Resize, so I had to use a loop. The loop is
definitely slower.
Your aside looks interesting and relevant, I'll have a look later
today.
Thanks for your help Alan.

Ken Johnson
Sounds interesting and relevant. I'll have a look a look a that

 

[Alan Beban]

Hi Alan,
It just looks to me like the way I set up my vaUniques array with just
the one index variable as in vaUniques(n) rather than with two as in
vaUniques (n,1) that this results in Excel not transferring the data to
the worksheet using Resize, so I had to use a loop. The loop is
definitely slower.

I haven't taken the time to set up a test case because much of your
posting is not relevant to this narrow issue; but I think the following
should work fine:

Sheet1.Range("B2").Resize(1,UBound(vaUniques)).Value = vaUniques

Alan Beban

 

[Tom Ogilvy]

Sheet1.Range("B2").Resize(1 to UBound(vaUniques, 1), _
1 to 1).Value = Application.Transpose(vaUniques)

 

[Ken Johnson]

Hi Dm Unseen,
Thanks for the link. My main reason for this post was not so much about
finding unique values. I was primarily interested in solving the
problem I was having with transferring data from an array to the
worksheet using Resize. Thanks to you guys I can now see what I was
doing wrong and that pleases me no end, and I can now use this
technique whenever the need arises.
Thanks again for all your help.

Ken Johnson

 

[Ken Johnson]

Hi Alan,
Looks like a clever trick. I'll certainly look into this one!
Thanks Alan

Ken Johnson

 

[Tom Ogilvy]

Sorry - got off track.



Sheet1.Range("B2").Resize(UBound(vaUniques, 1), _
1).Value = Application.Transpose(vaUniques)

 

[Ken Johnson]

Thanks again Tom
Ken Johnson