# Update Excel Macro for More Flexibility (Update which Columns to Use) on
Hello,
The code below was in response to this question:
I would like to compute correlation matrices (using CORRELATE) for each group in a worksheet. The correlation matrices should be by group (5,6,7,12,13, or 14) on columns D - H.  Ideally the new sheet would be named with at least the group number.

The code below works specifically on Columns D - H. The data I want to use this on will not always be in D - H. Is there a way to update the macro so that I can 'easily' change what columns should be used to make the correlation matrices?

Thanks,
Cheers,
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
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)
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-split-groups-into-worksheets.xlsx
Comment
Watch Question

Do more with EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
You could use this to get the column letter(s) you need

sColLetter1 = InputBox("Type in column letter", "Type in column letter", "D")

Commented:
bogunit:
Could you provide some help with implementing this code?
``````sColLetter1 = InputBox("Type in column letter", "Type in column letter", "D")
``````

Would this go in the 'range' part of the current code?
``````.Range("b2, c3, d4, e5, f6") = 1
``````

Thanks again,
Cheers,
JE
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
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)
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
``````

Commented:
This is the correct code from the referenced question:
``````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
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)
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
``````

Commented:
Thanks for the suggestion.

Do more with 