Excel CORREL macro with ability to change input data

justearth
justearth used Ask the Experts™
on
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:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27025172.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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solutions Only
gowflowPartner
Commented:
Pls be specific how many columns you need as a varaible and from where to where ?
gowflow
justearth

Author

Commented:
since I don't really know how to write macros, maybe I've got this wrong. The columns (how many and where) is variable. Is this possible to add to script?  if not how adaptable/dynamic can this script be made? I am ok with being to tell the macro before executing what data to use. Thanks again, JE

justearth

Author

Commented:
Hello,
In an attempt to answer only a part of the above question I asked another, less specific one here:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27044092.html

Which ended up answering the whole question.

Thanks,
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

Success in ‘20 With a Profitable Pricing Strategy

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Find out now!
Commented:
my bad,
this code

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
    Dim columnList As Variant
    Dim colNumbers As Variant
    
    columnList = Array("AREA1", "AREA2", "AREA3", "AREA4", "AREA5", "AREA6")
    
    ReDim colNumbers(UBound(columnList))
    Set SourceWs = ThisWorkbook.Worksheets("data")
    With SourceWs
        cnum = 0
        For i = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
            If IsInArray(.Cells(1, i), columnList) Then
                colNumbers(cnum) = i
                cnum = cnum + 1
            End If
        Next i
        .[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"
            .Range(.Cells(2, 1), .Cells(UBound(columnList) + 2, 1)).Value = Application.Transpose(columnList)
            .Range(.Cells(1, 2), .Cells(1, UBound(columnList) + 2)).Value = columnList
            For i = 2 To UBound(columnList) + 2
                .Cells(i, i) = 1
                For j = i + 1 To UBound(columnList) + 2
                    .Cells(j, i).Formula = "=CORREL(Data!R" & arr(2, Counter) & "C" & colNumbers(i - 2) & ":R" & arr(3, Counter) & "C" & colNumbers(i - 2) & ",Data!R" & arr(2, Counter) & "C" & colNumbers(j - 2) & ":R" & arr(3, Counter) & "C" & colNumbers(j - 2) & ")"
                Next j
            Next i
        End With
    Next
    
    MsgBox "Done"
    
End Sub

Public Function IsInArray(FindValue As Variant, arrSearch As Variant) As Boolean
    On Error GoTo LocalError
    If Not IsArray(arrSearch) Then Exit Function
    IsInArray = InStr(1, vbNullChar & Join(arrSearch, vbNullChar) & vbNullChar, vbNullChar & FindValue & vbNullChar) > 0
    
    Exit Function
    
LocalError:
    'Justin (just in case)
End Function

Open in new window


Cheers,
JE
gowflowPartner

Commented:
ok am lost. what do you require from this question ?

My understanding is that you need to be prompt on the columns to use is that correct ???
gowflow
justearth

Author

Commented:
The original code I posted above has columns D - H, 'hard coded' into the macro. I wanted the macro to be altered so that I could easily change the columns/data used.  The last script I posted accomplishes this.  

Thanks again,
JE
gowflowPartner

Commented:
then this question has no purpose if I understand well !???
gowflow
justearth

Author

Commented:
As of now, yes the above code fulfills my initial wants.  I had asked a more basic/general question after I posted this one. It's solution, however, proved to be enough to answer this question.  I was unsure on how to proceed at this stage.  The question was answered but you have already committed time to helping me find solution of my more complex question.  So as it goes I don't know the 'correct' way to terminate this question.

Thanks,
JE
gowflowPartner

Commented:
no problem for me you can simply delete the question or if you still wish attribute points to it. Strictly your choice and no problem for me as did not help you in finding your solution.
gowflow
justearth

Author

Commented:
Thanks for leading me to ask a refined, albeit different, question.  Cheers, JE
gowflowPartner

Commented:
Your welcome I didn't do much tks for the points shows your a great person. Hopw I can help you more next time.
rgds/gowflow

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial