[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Excel 2003 - Comparing Arrays

Posted on 2011-10-09
14
Medium Priority
?
242 Views
Last Modified: 2013-11-05
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!
0
Comment
Question by:TigerMan
  • 8
  • 6
14 Comments
 
LVL 6

Expert Comment

by:TinTombStone
ID: 36941486
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
 
LVL 5

Author Comment

by:TigerMan
ID: 36941534
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
 
LVL 6

Expert Comment

by:TinTombStone
ID: 36941665
What is 'ThisFoR '?
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 5

Author Comment

by:TigerMan
ID: 36941691
just another 4-digit numeric number like the others ...
0
 
LVL 6

Expert Comment

by:TinTombStone
ID: 36941866
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
 
LVL 6

Accepted Solution

by:
TinTombStone earned 500 total points
ID: 36943014
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
 
LVL 6

Expert Comment

by:TinTombStone
ID: 36943022
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
 
LVL 5

Author Comment

by:TigerMan
ID: 36945787
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
 
LVL 5

Author Comment

by:TigerMan
ID: 36945948
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
 
LVL 5

Author Comment

by:TigerMan
ID: 36946078
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
 
LVL 5

Author Comment

by:TigerMan
ID: 36946434
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
 
LVL 5

Author Closing Comment

by:TigerMan
ID: 36946441
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
 
LVL 6

Expert Comment

by:TinTombStone
ID: 36951416
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
 
LVL 5

Author Comment

by:TigerMan
ID: 36954010
Is cool ... I will have several more questions yet so you can dive in again as you wish :)
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

867 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question