PDA

View Full Version : Solved: From one array to another



paul_0722
06-21-2008, 06:05 AM
I am have a two dimension Excel array called "first" with repeating values in dimension 2. I want to copy only the unique values of the first array 2nd dimension to a one dimension array called "second". I thought I could do so by walking the first array and populating the second array each time the value changed, but that does not seem to be working - see code. Any help appreciated...


Option Explicit
Sub test()
Dim first(8, 2) As Integer
Dim second(3) As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
first(1, 1) = 1
first(1, 2) = 15
first(2, 1) = 2
first(2, 2) = 16
first(3, 1) = 3
first(3, 2) = 16
first(4, 1) = 4
first(4, 2) = 16
first(5, 1) = 5
first(5, 2) = 16
first(6, 1) = 6
first(6, 2) = 17
first(7, 1) = 7
first(7, 2) = 17
first(8, 1) = 8
first(8, 2) = 17
For a = 1 To UBound(first, 1)
For b = 1 To UBound(first, 2)
Cells(a, b) = first(a, b)
Next b
Next a
For a = 1 To 8
c = 1
If first(a, 2) <> first(a - 1, 2) Then
second(c) = first(a, 2)
c = c + 1
End If
Next a
Cells(1, 4) = second(1)
Cells(2, 4) = second(2)
Cells(3, 4) = second(3)
End Sub



The values of second array *should* be:
second(1) = 15
second(2) = 16
second(3) = 17

Bob Phillips
06-21-2008, 06:25 AM
Sub test()
Dim first(1 To 8, 1 To 2) As Integer
Dim second(1 To 3) As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
first(1, 1) = 1
first(1, 2) = 15
first(2, 1) = 2
first(2, 2) = 16
first(3, 1) = 3
first(3, 2) = 16
first(4, 1) = 4
first(4, 2) = 16
first(5, 1) = 5
first(5, 2) = 16
first(6, 1) = 6
first(6, 2) = 17
first(7, 1) = 7
first(7, 2) = 17
first(8, 1) = 8
first(8, 2) = 17
For a = 1 To UBound(first, 1)
For b = 1 To UBound(first, 2)
Cells(a, b) = first(a, b)
Next b
Next a
For a = 1 To 7
If first(a, 2) <> first(a + 1, 2) Then
c = c + 1
second(c) = first(a, 2)
End If
Next a
c = c + 1
second(c) = first(a - 1, 2)
Cells(1, 4) = second(1)
Cells(2, 4) = second(2)
Cells(3, 4) = second(3)
End Sub

mikerickson
06-21-2008, 09:07 AM
Sub test()
Dim first(1 To 8, 1 To 2) As Integer
Dim second() As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
first(1, 1) = 1
first(1, 2) = 15
first(2, 1) = 2
first(2, 2) = 16
first(3, 1) = 3
first(3, 2) = 16
first(4, 1) = 4
first(4, 2) = 16
first(5, 1) = 5
first(5, 2) = 16
first(6, 1) = 6
first(6, 2) = 17
first(7, 1) = 7
first(7, 2) = 17
first(8, 1) = 8
first(8, 2) = 17

ReDim second(1 To UBound(first, 1))
b = 0
For a = 1 To UBound(first, 1)
If Application.Match(first(a, 2), Application.Index(first, 0, 2), 0) = a Then
b = b + 1
second(b) = first(a, 2)
End If
Next a
ReDim Preserve second(1 To b)
Range("a1").Resize(b, 1).Value = Application.Transpose(second)
End Sub

paul_0722
06-21-2008, 02:35 PM
That works! Thanks very much