asked on
Sub MakeMatrix()
Dim arr() As Long
Dim CurrentGroup As Long
Dim SourceWs As Worksheet
Dim LastR As Long
Dim Counter As Long
Dim DestWs As Worksheet
Set SourceWs = ThisWorkbook.Worksheets("data")
With SourceWs
.[a1].Sort Key1:=.[a1], Order1:=xlAscending, Header:=xlYes
LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
CurrentGroup = .Cells(2, 1)
ReDim arr(1 To 3, 1 To 1) As Long
arr(1, 1) = CurrentGroup
arr(2, 1) = 2
For Counter = 3 To LastR
If .Cells(Counter, 1) <> CurrentGroup Then
arr(3, UBound(arr, 2)) = Counter - 1
ReDim Preserve arr(1 To 3, 1 To 1 + UBound(arr, 2)) As Long
arr(1, UBound(arr, 2)) = .Cells(Counter, 1)
arr(2, UBound(arr, 2)) = Counter
CurrentGroup = .Cells(Counter, 1)
ElseIf Counter = LastR Then
arr(3, UBound(arr, 2)) = Counter
End If
Next
End With
For Counter = 1 To UBound(arr, 2)
Set DestWs = ThisWorkbook.Worksheets.Add
With DestWs
.Name = "Group " & arr(1, Counter) & " Matrix"
.[a2:a6] = Application.Transpose(SourceWs.[d1:h1])
.[b1:f1].Value = SourceWs.[d1:h1].Value
.Range("b2, c3, d4, e5, f6") = 1
.[b3].Formula = "=CORREL(Data!D" & arr(2, Counter) & ":D" & arr(3, Counter) & _
",Data!E" & arr(2, Counter) & ":E" & arr(3, Counter) & ")"
.[b4].Formula = "=CORREL(Data!D" & arr(2, Counter) & ":D" & arr(3, Counter) & _
",Data!F" & arr(2, Counter) & ":F" & arr(3, Counter) & ")"
.[b5].Formula = "=CORREL(Data!D" & arr(2, Counter) & ":D" & arr(3, Counter) & _
",Data!G" & arr(2, Counter) & ":G" & arr(3, Counter) & ")"
.[b6].Formula = "=CORREL(Data!D" & arr(2, Counter) & ":D" & arr(3, Counter) & _
",Data!H" & arr(2, Counter) & ":H" & arr(3, Counter) & ")"
.[c4].Formula = "=CORREL(Data!E" & arr(2, Counter) & ":E" & arr(3, Counter) & _
",Data!F" & arr(2, Counter) & ":F" & arr(3, Counter) & ")"
.[c5].Formula = "=CORREL(Data!E" & arr(2, Counter) & ":E" & arr(3, Counter) & _
",Data!G" & arr(2, Counter) & ":G" & arr(3, Counter) & ")"
.[c6].Formula = "=CORREL(Data!E" & arr(2, Counter) & ":E" & arr(3, Counter) & _
",Data!H" & arr(2, Counter) & ":H" & arr(3, Counter) & ")"
.[d5].Formula = "=CORREL(Data!F" & arr(2, Counter) & ":F" & arr(3, Counter) & _
",Data!G" & arr(2, Counter) & ":G" & arr(3, Counter) & ")"
.[d6].Formula = "=CORREL(Data!F" & arr(2, Counter) & ":F" & arr(3, Counter) & _
",Data!H" & arr(2, Counter) & ":H" & arr(3, Counter) & ")"
.[e6].Formula = "=CORREL(Data!G" & arr(2, Counter) & ":G" & arr(3, Counter) & _
",Data!H" & arr(2, Counter) & ":H" & arr(3, Counter) & ")"
End With
Next
MsgBox "Done"
End Sub
JE-EE-corr-matrix-by-group.xlsx