checking array values for matches

[LePig]

Hi,

I have an array for example

arr(1) - mackeral
arr(2) - Tuna
arr(3) - Salmon
arr(4) - Salmon
arr(5) - Cod
arr(6) - mackeral
arr(7) - Tuna
arr(8) - Cod
arr(9) - Salmon
arr(10) - Cod

I need to check the arr values for any matches.

So for example check arr(1) against arr(2) to arr(10) and so on until all are checked against each other.

For example if checking

arr(1) - Mackerel
It would return the number 6 as the match

If checking arr(2) - Tuna
It would return the number 7 as the match

I want it to return the numbers as the matches.

From this information i want to get average prices.

Any pointers would be greatly appreciated.

Kind Regards

Matt

 

[oldbrewer]

mackeral

6

Tuna

7

Salmon

4

9

Salmon

9

Cod

8

10

mackeral

Tuna

Cod

10

Salmon

very easy to change it so all matches displayed

Cod

eg against cod in row 10 it would put 5 and 8

this macro added the above numbers

Sub Macro4()

'

' Macro4 Macro

' Macro recorded 21/02/2018 by bob

'

'

Dim arr(20), temp(20)

For q = 1 To 10

arr(q) = Cells(q, 1)

Next q

For j = 1 To 9

For k = j + 1 To 10

If arr(j) <> arr(k) Then GoTo 200 Else GoTo 100

100 Sum = Sum + 1

temp(Sum) = k

200 Next k

If Sum = 0 Then GoTo 300

For z = 1 To Sum

Cells(j, z + 1) = temp(z)

Next z

Sum = 0

For x = 1 To 20: temp(x) = "": Next x

300 Next j

999 End Sub

<colgroup><col><col span="12"></colgroup><tbody>
</tbody>

 

[MickG]

Try this for results:- Fish in columns "A", Number Matches in column "B".

[COLOR="Navy"]Sub[/COLOR] MG21Feb40
[COLOR="Navy"]Dim[/COLOR] Arr(1 To 10), R [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Arr(1) = "mackeral"
Arr(2) = "Tuna"
Arr(3) = "Salmon"
Arr(4) = "Salmon"
Arr(5) = "Cod"
Arr(6) = "mackeral"
Arr(7) = "Tuna"
Arr(8) = "Cod"
Arr(9) = "Salmon"
Arr(10) = "Cod"
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Arr)
    [COLOR="Navy"]If[/COLOR] Not .Exists(Arr(n)) [COLOR="Navy"]Then[/COLOR]
        .Add Arr(n), n
    [COLOR="Navy"]Else[/COLOR]
        .Item(Arr(n)) = .Item(Arr(n)) & ", " & n
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("A1").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick
http://www.dec.org.uk/