Excel 2003 - Comparing Arrays

Hi

I have FoRArtsArr with n records by 20 columns.  In columns 10, 13, and 16 there can be only one of 157 possible values (these values are always 4-character numeric i.e. 0102, 0906, 1407, etc).

I wish to create a new single column array (RelatedFoRsArr) that contains a unique list of the values in column 10, 13, and 16 of FoRArtsArr except ThisFoR (to be tested in the main routine, not as an afterthought).  RelatedFoRsArr should have only as many rows as there are unique values from FoRArtsArr.

Please avoid geek-speak-coding i.e. proper variable names and structured routines so I can understand and modify as needed.

I am not able to check in every day so please anticipate delays in my replying … thanks in advance!
LVL 5
TigerManAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

TinTombStoneCommented:
This code worked for me.  I'm sure this could be improved, but it is a start

It first sorts your array by the required column
then picks out each unique value from the column and drops it into a collection
Repeats for the other columns
then loads the values from the collection in your new array and sorts them

Dim colUniqueVals As Collection



Sub GetUniqueArrayVals()
Dim FoRArtstempArr() As Variant
Dim RelatedFoRstempArr()

    'This just created a temp tempArray for my practice
    FoRArtstempArr() = Range("A1:S33")
    
    'initialise new arrCollection to store unique values later
    Set colUniqueVals = New Collection

    'sort  FoRArtstempArr by Column 10
    SortArray FoRArtstempArr, 10
    'load unique values from Column 10 into a Collection
    LoadUniqueValues FoRArtstempArr, 10
    
    'repeat for Column 13 and 16
    SortArray FoRArtstempArr, 13
    LoadUniqueValues FoRArtstempArr, 13
    
    SortArray FoRArtstempArr, 16
    LoadUniqueValues FoRArtstempArr, 16
    
    'redim to size of arrCollection
    ReDim RelatedFoRstempArr(1 To colUniqueVals.Count)
    
    'load arrCollection values into RelatedFoRstempArr
    For i = 1 To colUniqueVals.Count
        RelatedFoRstempArr(i) = colUniqueVals(i)
    Next i
    
    'sort RelatedFoRstempArr
    SortArray RelatedFoRstempArr


End Sub



Sub SortArray(ByRef tempArr, Optional arrCol As Integer)
'procedure to sort arrColumn of tempArray
Dim arrRow As Long
Dim tempVal As Variant
    If Not arrCol = 0 Then
        For arrRow = 1 To UBound(tempArr, 1) - 1
            If tempArr(arrRow, arrCol) > tempArr(arrRow + 1, arrCol) Then
                tempVal = tempArr(arrRow, arrCol)
                tempArr(arrRow, arrCol) = tempArr(arrRow + 1, arrCol)
                tempArr(arrRow + 1, arrCol) = tempVal
                SortArray tempArr, arrCol
            End If
        Next
    Else
        For arrRow = 1 To UBound(tempArr, 1) - 1
            If tempArr(arrRow) > tempArr(arrRow + 1) Then
                tempVal = tempArr(arrRow)
                tempArr(arrRow) = tempArr(arrRow + 1)
                tempArr(arrRow + 1) = tempVal
                SortArray tempArr
            End If
        Next
    End If

End Sub


Sub LoadUniqueValues(ByRef tempArr, arrCol As Integer)
'procedure to load unique values into a arrCollection
Dim arrRow As Long
Dim uCount As Long
On Error Resume Next
    For arrRow = 1 To UBound(tempArr, 1)
        If tempArr(arrRow, arrCol) <> tempArr(arrRow + 1, arrCol) Then
            colUniqueVals.Add tempArr(arrRow, arrCol)
        End If
    Next
End Sub

Open in new window

0
TigerManAuthor Commented:
hi tts,

that looks like its on the right track ... just one thing ... I don't see this requirement coded into that module:

"except ThisFoR (to be tested in the main routine, not as an afterthought)."

is it there? if yes, please point me to it ... if no, can you add in please?

nb: it is important that this ie included in the LoadUniqueValues sub
0
TinTombStoneCommented:
What is 'ThisFoR '?
0
Cloud Class® Course: Certified Penetration Testing

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

TigerManAuthor Commented:
just another 4-digit numeric number like the others ...
0
TinTombStoneCommented:
OK.

How will the code know what 'ThisFoR' is?

In order to exclude it from the results we need to know what the value is
0
TinTombStoneCommented:
Sorry, I'm being stupid!  THisFor is a variable

Try this
Dim FoRArtstempArr() As Variant
Dim RelatedFoRstempArr()

Dim itm As Long

THisFoR = 99999

    'This just created a temp tempArray for my practice
    FoRArtstempArr() = Range("A1:S31")
    
    'initialise new arrCollection to store unique values later
    Set colUniqueVals = New Collection

    'sort  FoRArtstempArr by Column 10
    SortArray FoRArtstempArr, 10
    'load unique values from Column 10 into a Collection
    LoadUniqueValues FoRArtstempArr, 10
    
    'repeat for Column 13 and 16
    SortArray FoRArtstempArr, 13
    LoadUniqueValues FoRArtstempArr, 13
    
    SortArray FoRArtstempArr, 16
    LoadUniqueValues FoRArtstempArr, 16
    
    'redim to size of arrCollection
    ReDim RelatedFoRstempArr(1 To colUniqueVals.Count)
    
    'load arrCollection values into RelatedFoRstempArr
    For i = 1 To colUniqueVals.Count
        RelatedFoRstempArr(i) = colUniqueVals(i)
    Next i
    
    'sort RelatedFoRstempArr
    SortArray RelatedFoRstempArr

    

End Sub



Sub SortArray(ByRef tempArr, Optional arrCol As Integer)
'procedure to sort arrColumn of tempArray
Dim arrRow As Long
Dim tempVal As Variant
    If Not arrCol = 0 Then
        For arrRow = 1 To UBound(tempArr, 1) - 1
            If tempArr(arrRow, arrCol) > tempArr(arrRow + 1, arrCol) Then
                tempVal = tempArr(arrRow, arrCol)
                tempArr(arrRow, arrCol) = tempArr(arrRow + 1, arrCol)
                tempArr(arrRow + 1, arrCol) = tempVal
                SortArray tempArr, arrCol
            End If
        Next
    Else
        For arrRow = 1 To UBound(tempArr, 1) - 1
            If tempArr(arrRow) > tempArr(arrRow + 1) Then
                tempVal = tempArr(arrRow)
                tempArr(arrRow) = tempArr(arrRow + 1)
                tempArr(arrRow + 1) = tempVal
                SortArray tempArr
            End If
        Next
    End If

End Sub


Sub LoadUniqueValues(ByRef tempArr, arrCol As Integer)
'procedure to load unique values into a arrCollection
Dim arrRow As Long
Dim uCount As Long
On Error Resume Next
    For arrRow = 1 To UBound(tempArr, 1)
        If tempArr(arrRow, arrCol) <> tempArr(arrRow + 1, arrCol) And tempArr(arrRow, arrCol) <> THisFoR Then
            colUniqueVals.Add tempArr(arrRow, arrCol)
        End If
    Next
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
TinTombStoneCommented:
Sorry again, this
Dim colUniqueVals As Collection
Dim THisFoR As Long


Sub GetUniqueArrayVals()
Dim FoRArtstempArr() As Variant
Dim RelatedFoRstempArr()

Dim itm As Long

THisFoR = 99999

    'This just created a temp tempArray for my practice
    FoRArtstempArr() = Range("A1:S31")
    
    'initialise new arrCollection to store unique values later
    Set colUniqueVals = New Collection

    'sort  FoRArtstempArr by Column 10
    SortArray FoRArtstempArr, 10
    'load unique values from Column 10 into a Collection
    LoadUniqueValues FoRArtstempArr, 10
    
    'repeat for Column 13 and 16
    SortArray FoRArtstempArr, 13
    LoadUniqueValues FoRArtstempArr, 13
    
    SortArray FoRArtstempArr, 16
    LoadUniqueValues FoRArtstempArr, 16
    
    'redim to size of arrCollection
    ReDim RelatedFoRstempArr(1 To colUniqueVals.Count)
    
    'load arrCollection values into RelatedFoRstempArr
    For i = 1 To colUniqueVals.Count
        RelatedFoRstempArr(i) = colUniqueVals(i)
    Next i
    
    'sort RelatedFoRstempArr
    SortArray RelatedFoRstempArr

    

End Sub



Sub SortArray(ByRef tempArr, Optional arrCol As Integer)
'procedure to sort arrColumn of tempArray
Dim arrRow As Long
Dim tempVal As Variant
    If Not arrCol = 0 Then
        For arrRow = 1 To UBound(tempArr, 1) - 1
            If tempArr(arrRow, arrCol) > tempArr(arrRow + 1, arrCol) Then
                tempVal = tempArr(arrRow, arrCol)
                tempArr(arrRow, arrCol) = tempArr(arrRow + 1, arrCol)
                tempArr(arrRow + 1, arrCol) = tempVal
                SortArray tempArr, arrCol
            End If
        Next
    Else
        For arrRow = 1 To UBound(tempArr, 1) - 1
            If tempArr(arrRow) > tempArr(arrRow + 1) Then
                tempVal = tempArr(arrRow)
                tempArr(arrRow) = tempArr(arrRow + 1)
                tempArr(arrRow + 1) = tempVal
                SortArray tempArr
            End If
        Next
    End If

End Sub


Sub LoadUniqueValues(ByRef tempArr, arrCol As Integer)
'procedure to load unique values into a arrCollection
Dim arrRow As Long
Dim uCount As Long
On Error Resume Next
    For arrRow = 1 To UBound(tempArr, 1)
        If tempArr(arrRow, arrCol) <> tempArr(arrRow + 1, arrCol) And tempArr(arrRow, arrCol) <> THisFoR Then
            colUniqueVals.Add tempArr(arrRow, arrCol)
        End If
    Next
End Sub

Open in new window

0
TigerManAuthor Commented:
lol ... yes, ThisFoR is a variable.
thanks so far ... i didn't mention the number of records and i think that is a stumbling block to sorting routines
I have played with the above somewhat.  It is returning out of stack space and a few issues.
I also have a sample of data to run this over (currently 11,700 records, but will grow to about 25000 later) and therefore UBound(tempArr, 1) (in For arrRow = 1 To UBound(tempArr, 1)) is quite large.  I suspect this is why the stack space problem?  I wonder if walkenbach's counting sort would do this volume better?
that said, i am not sure there is a need to sort ArtsArr? here is my uninformed thinking

dim UniqueList
for counter = 1 to ubound(FoRArtsArr, 1)
for each fielditem(10, 13, 16)
if FoRArtsArr(counter,fielditem) <> ThisFoR and FoRArtsArr(counter,fielditem) not in UniqueList then
Shove in UniqueList
end if
next fielditem
next counter

does that make sense and does it provide valid pseudocode?
0
TigerManAuthor Commented:
here is better pseudocode for what i was thinking

Dim UniqueFoRs, Counter1, Counter2, Test
For Counter1 = 1 To UBound(ArtsArr, 1)
    For Each FieldItem In Array(10, 13, 16)
        Test = ArtsArr(Counter1, FieldItem)
        For Counter2 = 1 To UBound(UniqueFoRs, 1)
            If UniqueFoRs(Counter2) <> Test Then
                ReDim UniqueFoRs(UBound(UniqueFoRs) + 1, 1)
                UniqueFoRs(UBound(UniqueFoRs, 1)) = Test
            End If
        Next Counter2
    Next FieldItem
Next Counter1

is this faster? better use of resources?  does it work?
0
TigerManAuthor Commented:
And here is code that works to achieve the desired outcome ... runs in about 2 seconds over 11,000 records

a couple of questions
1: can this be made more efficient?
2: can you give the vb to transpose UniqueFoRs?


Dim UniqueFoRs(), ArtCounter, UniqueCounter, Test, NumRecs, AddRec
ReDim UniqueFoRs(1, 1)
NumRecs = 1
AddRec = True
For ArtCounter = 1 To UBound(ArtsArr, 1)
    For Each FieldItem In Array(10, 13, 16)
        Test = ArtsArr(ArtCounter, FieldItem)
        If Test <> "" And Test <> ThisFoR Then
            For UniqueCounter = 1 To UBound(UniqueFoRs, 2)
                If UniqueFoRs(1, UniqueCounter) = Test Then
                    AddRec = False
                End If
            Next UniqueCounter
            If AddRec Then
                UniqueFoRs(1, NumRecs) = Test
                NumRecs = NumRecs + 1
                ReDim Preserve UniqueFoRs(1, NumRecs) ' need to transpose
            End If
        End If
        AddRec = True
    Next FieldItem
Next ArtCounter

Open in new window

0
TigerManAuthor Commented:
OK, I have completed this one and all specs are met.
It was working through your models that gave me the impetus to seek different ways to resolve this algorithm; you have also put considerable effort into assisting.  Therefore I will give you points but will modify downwards for incomplete answer.
I hope this is cool for you?
' assemble unique FoRs from FoRArts into UniqueFoRs

Dim UniqueFoRs(), FoRArtCounter, UniqueCounter, Test, NumRecs, AddRec, tempArr
ReDim UniqueFoRs(1, 1)
NumRecs = 1     'tracks number of rows in UniqueFoRs
AddRec = True   'discriminates whether to add new row to UniqueFoRs
For FoRArtCounter = 1 To UBound(FoRArts, 1) 'FoRArts is list of arts related to ThisFoR
    For Each FieldItem In Array(10, 13, 16)
        Test = FoRArts(FoRArtCounter, FieldItem)
        If Test <> "" And Test <> ThisFoR Then  'caters for blanks and matches with ThisFoR
            For UniqueCounter = 1 To UBound(UniqueFoRs, 2) 'cycle thru UniqueFoRs
                If UniqueFoRs(1, UniqueCounter) = Test Then
                    AddRec = False  'if FoR exists then don't add new record
                End If
            Next UniqueCounter
            If AddRec Then
                UniqueFoRs(1, NumRecs) = Test   'add the record
                NumRecs = NumRecs + 1           'increment row count in UniqueFoRs
                ReDim Preserve UniqueFoRs(1, NumRecs) ' need to transpose
            End If
        End If
        AddRec = True
    Next FieldItem
Next FoRArtCounter
ReDim Preserve UniqueFoRs(1, UBound(UniqueFoRs, 2) - 1)
tempArr = Application.Transpose(UniqueFoRs)
UniqueFoRs = tempArr

Open in new window

0
TigerManAuthor Commented:
I don't know if these ratings can be changed after posting, but if you are not happy with this please let me know.
Am only trying to be objective :)
0
TinTombStoneCommented:
Hi TigerMan

Sorry been at work for a day.  Thats great, I'm going to have a look at your solution tomorrow, I'm sure it will help me too.

I thought you may have a problem with stack overflow on the sort and going to try and correct it.  

Glad to have been of a little help, I'm sure your code will teach me a lot to

TTT
0
TigerManAuthor Commented:
Is cool ... I will have several more questions yet so you can dive in again as you wish :)
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.