View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default help! how to delete useless rows in 2 dim array by VBA

The problem with a 2D array is that your can not redim preserve on the first
dimension (rows). You would basically have to copy to a second array as you
go, or another approach would be to use application.Transpose to reverse the
row and column order.

Sub AdjustArray()
Dim ar As Variant, v As Variant
Dim i As Long, j As Long, k As Long
ReDim ar(1 To 20, 1 To 5)
' Build a test array with some empty elements in the first column
For i = 1 To 20
If Rnd() < 0.5 Then
For j = 1 To 5
ar(i, j) = Int(Rnd() * 100 + 1)
Next
End If
Next i
Range("A1:E20").Value = ar
v = Application.Transpose(ar)

j = LBound(v, 2) - 1
For i = LBound(v, 2) To UBound(v, 2)
If Not IsEmpty(v(1, i)) Then
j = j + 1
For k = LBound(v, 1) To UBound(v, 1)
v(k, j) = v(k, i)
Next
End If
Next
ReDim Preserve v(LBound(v, 1) To UBound(v, 1), LBound(v, 2) To j)
ar = Application.Transpose(v)
Range("G1").Resize(UBound(ar, 1), UBound(ar, 2)).Value = ar
Erase v
End Sub

For simplicity, some of the code assumes a lower bound of 1 in each
dimension. Since your array will come from a range, this should not be a
problem.

--
Regards,
Tom Ogilvy




"xiang" wrote in
message ...

hi, Tom
here is your code to remove blank entries from array
It works perfect in one-dim array. How could I make it work for 2-dim
array.
that is something I want.

removing blank entries from an array


--------------------------------------------------------------------------

------

j = lbound(ar) - 1
for i = lbound(ar) to ubound(ar)
if ar(i) < "" then
j = j + 1
ar(j) = ar(i)
end if
Next
Redim Preserve ar(lbound(ar) to j)

--
Regards,
Tom Ogilvy



--
xiang
------------------------------------------------------------------------
xiang's Profile:

http://www.excelforum.com/member.php...o&userid=29489
View this thread: http://www.excelforum.com/showthread...hreadid=496567