Thread: Complex correlations

Hi all
I've been trying to find a way to compare and code correlations,
the following is a list of mean values:
Day Mean
1 58
2 12
3 35
4 14
5 42
6 9
7 12
LSD= 17
Any difference between means smaller than the 'least significant difference' (LSD) is not significant, anything equal to or over LSD is significant.
I need to attribute means to groups; the means within a group are not significantly different from each other but are significantly different from the means in other groups.
Groups would be letters a - g
Values can be in more than one group
The group with the smallest mean must be group 'a', the next mean value significantly different from any member of group 'a' must begin group 'b' and so on.
The above example should read:
Day Mean Group
1 58 c
2 12 a
3 35 b
4 14 a
5 42 b,c
6 9 a
7 12 a

Hopefully you can help before I pull all my hair out!

I can't get this code to work in all situations sorry; when all means are different from each other for example. I tried working with your code but my programming isn't good enough- the only way I can get this to work is by using long nested formulas and since they're so nested they'll only work in excel 2007 which means I can't work on them at home.... is it possible to write VBA along these lines?
For these formulas it's essential that a 'sort by column b' runs first so that all means are in ascending order, a 'sort by column a' after to put everything back in the right order is handy too but whether this is essential in VBA I'm not sure!

I attached an xlsx for anyone with 2007 and a doc to show the formulas for anyone without.

Kind regards all


There is a problem with these formulas please ignore their system

I will take a look, but could you provide an example of it not working? I probably haven't understood fully all the concepts involved.

EDIT: in the meantime, see if this addresses any problems. You'll see that it puts some formulae in K and L, but these could be moved or removed. First, see if it rectifies problems.

Sub x()

Dim rMean As Range, r As Range, r2 As Range
Dim nLSD As Long, i As Long, j As Long, n As Long
Dim vGp As Variant, vGp2 As Variant

vGp = Array("a", "b", "c", "d", "e", "f", "g")
nLSD = 17
Set rMean = Range("B2", Range("B2").End(xlDown))

For Each r In rMean
    r.Offset(, 9) = Int(r.Value / nLSD) + 1
Next r

rMean.Offset(, 10).Formula = "=Rank(K2," & rMean.Offset(, 9).Address & ",1)"

For Each r In rMean
    r.Offset(, 1) = vGp(r.Offset(, 10) - 1)
Next r

vGp2 = rMean.Offset(, 1).Value

With Application
    For Each r In rMean
        j = j + 1
        If j = rMean.Count Then Exit Sub
        For Each r2 In rMean.Offset(j).Resize(rMean.Rows.Count - j)
            If Abs(r - r2) <= nLSD And r < r2 And vGp2(.Match(r, rMean, 0), 1) <> vGp2(.Match(r2, rMean, 0), 1) Then
                r.Offset(, 1) = r.Offset(, 1) & "," & r2.Offset(, 1)
            ElseIf Abs(r - r2) <= nLSD And r > r2 And vGp2(.Match(r, rMean, 0), 1) <> vGp2(.Match(r2, rMean, 0), 1) Then
                r2.Offset(, 1) = r2.Offset(, 1) & "," & r.Offset(, 1)
            End If
        Next r2
    Next r
End With

End Sub

No, it's quite a teaser. I have reached a mental block when it comes to the ranking bit. When I get through that will post back!

EDIT: actually, no it is driving me a bit crazy. I have sorted out the ranking issue which addresses the first two cases in your file. However, the other two suggest that there is a fundamental problem with my method which needs re-examination. I hope you're not in a hurry.

Graham - I have a little wax effigy I stick pins into so that I can vent my spleen while appearing placid on the forum. Below is a slightly different (and simpler) approach which seems to work in some of the cases where it previously didn't. However, I was not entirely clear from your example where all the problems were, so please feel free to elaborate on that. I hope we're making progress.

Sub x()

Dim rMean As Range, r As Range, r2 As Range
Dim nLSD As Range, i As Long, j As Long, dMax As Double
Dim vGp As Variant, vGp2 As Variant

Application.ScreenUpdating = False

vGp = Array("a", "b", "c", "d", "e", "f", "g")
Set nLSD = Range("D2")
Range("A1").CurrentRegion.Sort key1:=Range("B1"), order1:=xlAscending, Header:=xlYes

Set rMean = Range("B2", Range("B2").End(xlDown))
rMean.Offset(, 1).ClearContents

For Each r In rMean
    If r.Row = rMean(1).Row Then
        i = 0
        dMax = r
    ElseIf r - r.Offset(-1) > nLSD Or (r - r.Offset(-1) <= nLSD And r - dMax > nLSD) Then
        i = i + 1
        dMax = r
    Else
        dMax = WorksheetFunction.Max(dMax, r)
    End If
    r.Offset(, 1) = vGp(i)
Next r

vGp2 = rMean.Offset(, 1).Value

With Application
    For Each r In rMean
        j = j + 1
        If j = rMean.Count Then GoTo line1
        For Each r2 In rMean.Offset(j).Resize(rMean.Rows.Count - j)
            If Abs(r - r2) <= nLSD And r < r2 And vGp2(.Match(r, rMean, 0), 1) <> vGp2(.Match(r2, rMean, 0), 1) Then
                r.Offset(, 1) = r.Offset(, 1) & "," & r2.Offset(, 1)
            ElseIf Abs(r - r2) <= nLSD And r > r2 And vGp2(.Match(r, rMean, 0), 1) <> vGp2(.Match(r2, rMean, 0), 1) Then
                r2.Offset(, 1) = r2.Offset(, 1) & "," & r.Offset(, 1)
            End If
        Next r2
    Next r
End With

line1:
Range("A1").CurrentRegion.Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes

Application.ScreenUpdating = True

End Sub