Avatar of justearth
justearth
Flag for United States of America

asked on 

Excel CORREL macro with ability to change input data

Hello,
I would like a macro to perform the excel function CORREL.  The output is a correlation matrix. I would like to be able to 'easily' change what data is included in the macro.

I have attached an example output (which only uses group 5 data).  It uses the data from columns D-H, but I will need to be able to use other columns too, or different columns.

The code below is from this question:
https://www.experts-exchange.com/questions/27025172/Create-Correlation-Matrices-based-on-Groups-CORRELATE.html

It separates by groups and then does CORREL only on columns D - H. I don't know where or how to start making a macro that has easily changeable input data for CORREL.  Eventually, I'd like to have it work by group, but for now I would be more than satisfied to have it work with changeable input data parameters.

Thank you,
JE
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

Open in new window

JE-EE-corr-matrix-by-group.xlsx
Microsoft ExcelVisual Basic Classic

Avatar of undefined
Last Comment
Jacques Geday

8/22/2022 - Mon