Use Column Header Names Instead of Column Letters in Formula in a Macro

justearth
justearth used Ask the Experts™
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 fact that it only works on D - H, is hanging me up.  Instead of using the "Column Letters" D - H, I'd like to insert the column header names (i.e. those in row 1).  

I have attached an example worksheet showing the 'data' and example output (e.g. CORREL on Columns D - H on Group 5).  I have been asking a few questions on this topic. I am trying to get at the core idea of how to make the macro more adaptable. I hope this is clear and explains my goal.

I thought if I could enter the column names then I could easily change what data is included in the CORREL formula within the macro.

Please advise,
Thanks,
Cheers,
JE

previous questions:
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27040912.html
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27025172.html
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®
Commented:
Try this out. For testing purposes I just copied column H ("AREA5") to column I (called it "AREA6").  
JE-EE-corr-matrix-by-group.v2.xlsm

Then I changed the code to this:
 
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



In line 12, just type out your column headings as shown in the example, and it should work with any number
Most Valuable Expert 2012
Top Expert 2012

Commented:
I'm working on this (have to run to a meeting but will be back, shortly).   I'm going to assume a selection of random columns, then update the code based on that selection.

The selection will be an array of column headers:  dim columnNames() as string.

So if you select AREA1, AREA2, and SAREA5, you want the CORREL matrix based on that 3 x 3, correct?

Should not take long.

Dave

Commented:
Dave, that approach sounds very familiar ;-) lol
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!

Author

Commented:
m4trix:
thanks testing now.
dlmille:
Yes.

Cheers,
JE

Author

Commented:
m4trix:
Thanks this works how I wanted. It took me awhile to explain well I think.

Cheers,
JE

Author

Commented:
Thanks again.

Commented:
no problem. It was actually a fun little challenge :)
Most Valuable Expert 2012
Top Expert 2012

Commented:
nicely done :)

Dave

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