Topic: Redim Array

[Robert98]

I want to remove duplicated x and their related y from two arrays , but I receive this error :
       Array already dimensioned !
What's wrong with my codes ?
Suppose I have these values and I want to remove the 3rd line [(X2) and Y(2)] that is duplicated :
Dim x(0 To 3) As Double, y(0 To 3) As Double
x(0) = 0.29
y(0) = 0.89
x(1) = 0.34
y(1) = 0.44
x(2) = 0.29
y(2) = 0.89
x(3) = 0.12
y(3) = 0.86

Code: [Select]

Private Sub Remove_Duplicate(X() as double,Y() as double )

 Dim i As Long, elem As Variant
For Each elem In x
     For i = elem.Index + 1 To UBound(x)
        x(i - 1) = x(i)
           ReDim Preserve x(i - 1)
             y(i - 1) = y(i)
               ReDim Preserve y(i - 1)
     Next
  Next elem
End Sub

[fixo]

You could not redim first dimensioning
in multiple array, just a second one
Here is way how to recreate new array after
removing the dupes:

Code: [Select]

'make sure you checked in Tools->Options->General->Error trapping->'Break on Unhandled Errors'
Sub TestRemove_Dupes()

Dim x(0 To 3) As Double, y(0 To 3) As Double
x(0) = 0.29
y(0) = 0.89
x(1) = 0.34
y(1) = 0.44
x(2) = 0.29
y(2) = 0.89
x(3) = 0.12
y(3) = 0.86
Dim coll As New Collection
Dim i, j
Dim itm(0 To 1)
For i = 0 To UBound(x)
itm(0) = x(i): itm(1) = y(i)
On Error Resume Next
coll.Add itm, CStr(x(i)) & CStr(y(i))
Next
ReDim ar(0 To coll.Count - 1, 0 To 1)
'colllection items starts from 1
For i = 1 To coll.Count
ar(i - 1, 0) = coll.item(i)(0): ar(i - 1, 1) = coll.item(i)(1)

Next
For i = 0 To UBound(ar)
Debug.Print ar(i, 0) & " | " & ar(i, 1)
Next
End Sub

[Robert98]

You could not redim first dimensioning
in multiple array, just a second one
Here is way how to recreate new array after
removing the dupes:

Code: [Select]

'make sure you checked in Tools->Options->General->Error trapping->'Break on Unhandled Errors'
Sub TestRemove_Dupes()

Dim x(0 To 3) As Double, y(0 To 3) As Double
x(0) = 0.29
y(0) = 0.89
x(1) = 0.34
y(1) = 0.44
x(2) = 0.29
y(2) = 0.89
x(3) = 0.12
y(3) = 0.86
Dim coll As New Collection
Dim i, j
Dim itm(0 To 1)
For i = 0 To UBound(x)
itm(0) = x(i): itm(1) = y(i)
On Error Resume Next
coll.Add itm, CStr(x(i)) & CStr(y(i))
Next
ReDim ar(0 To coll.Count - 1, 0 To 1)
'colllection items starts from 1
For i = 1 To coll.Count
ar(i - 1, 0) = coll.item(i)(0): ar(i - 1, 1) = coll.item(i)(1)

Next
For i = 0 To UBound(ar)
Debug.Print ar(i, 0) & " | " & ar(i, 1)
Next
End Sub

Hi Fixo. Thanks for your efficient solution. I'm so sorry for late responding though. I was kind of busy and there were some stuffs to be done.
Sincerely, Robert

[fixo]

NP
Have a nice day

[RICVBA]

or you could declare the vectors with no dimensions in the main Sub (the one that calls the "Remove_Duplicate" Sub), and immediately Redimming them with initial known dimensions (no need for "Preserve" keyword in this phase). And then redimming them again with "Preserve" keyword inside the Sub after the shifting values loop is completed. like follows

Code: [Select]

Sub Main()

Dim X() As Double, Y() As Double

ReDim X(0 To 3)
ReDim Y(0 To 3)
X(0) = 0.29
Y(0) = 0.89
X(1) = 0.34
Y(1) = 0.44
X(2) = 0.29
Y(2) = 0.89
X(3) = 0.12
Y(3) = 0.86

Call Remove_Duplicate(X, Y, 2)

End Sub

Private Sub Remove_Duplicate(X() As Double, Y() As Double, MyIndex As Long)

Dim i As Long
Dim UbX As Integer

UbX = UBound(X) ' we'll assume the same dimension for Y()

For i = MyIndex + 1 To UbX
    X(i - 1) = X(i)
    Y(i - 1) = Y(i)
Next

ReDim Preserve Y(UbX - 1)
ReDim Preserve X(UbX - 1)

End Sub

it's surely less interesting than Fixo's piece of advice (his knowledge always astounds me). and don't know if less efficient. on the other hand it's shorter and this always appeals to me.

bye

[fixo]

Nice shot, I like it
Regards

[Robert98]

Acclamation  RICVBA  , very nice technique
Certainly , I'll use it tonight .
Thanks and have good day ...