VBA-Excel Look for column names, return their number and use column letters in function

Question

I'm quite new at VBA. I've used it in excel for a couple macros, but this one is way above my head. I'm looking to create a macro that will find the appropriate column, then based on the value in this columns, changes the values in three other columns. I already have a static macro:

    Sub AdjustForNoIntent()
    'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
    Dim lastrow As Long
    Dim i As Long
    lastrow = Range("AE" & Rows.Count).End(xlUp).Row
    For i = 2 To lastrow
        If Not IsError(Range("AE" & i).Value) Then
            If Range("AE" & i).Value = "No" And Range("U" & i).Value = "MEM" Then
                Range("U" & i).Value = "C-MEM"
                Range("Y" & i).ClearContents
                Range("AJ" & i).Value = "N/A"
            ElseIf Range("AE" & i).Value = "No" And Range("U" & i).Value = "VCH" Then
                Range("U" & i).Value = "C-VCH"
                Range("Y" & i).ClearContents
                Range("AJ" & i).Value = "N/A"
            End If
        End If
    Next i
End Sub

But this is a shared workbook, so people are adding columns randomly and every time I need to go back to the code and modify the columns refereces. What I want is, for instance, to look for column with "Role" header in row A3 and to insert it where the macro looks for column "U". That way other users can add/delete columns but I won't have to modify the macro every time.

In other macros, I manage to have this thing working:

Function fnColumnNumberToLetter(ByVal ColumnNumber As Integer)
    fnColumnNumberToLetter = Replace(Replace(Cells(1,ColumnNumber).Address, "1", ""), "$", "")
End Function

    Dim rngColumn As Range
    Dim ColNumber As Integer
    Dim ColName As String

  ColName = "Email Address"

  Sheets("Tracking").Select
  Set rngColumn = Range("3:3").Find(ColName)


  ColNumber = Sheets("Tracking").Range(rngColumn, rngColumn).Column

  Sheets("Combined").Range(ActiveCell, "W2").FormulaLocal = "=IF(ISERROR(INDEX(Tracking!$A:$A,MATCH(O:O,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0))), INDEX(Tracking!$A:$A,MATCH(U:U,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0)), INDEX(Tracking!$A:$A,MATCH(O:O,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0)))"

However, I am unable to link the latter to the first and much less to get it to find multiple columns. Any help is appreciated.

EDIT: Following suggestions, here is the new code. Doesn't return an error, but doesn't do anything either. It loops through the c loop ok, but jumps from For i =2 ... line to End Sub.

    Sub Adjust()

    Dim lastrow As Long
    Dim i As Long
    Dim headers As Dictionary
    Dim c As Long

    Set headers = New Scripting.Dictionary

For c = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
    headers.Add Cells(3, c).Value, c
Next c

    lastrow = Cells(headers.Item("Survey: Interest to Participate") & Rows.Count).End(xlUp).Row
    For i = 2 To lastrow
        If Not IsError(Cells(i, headers.Item("Survey: Interest to Participate")).Value) Then
            If Cells(i, headers.Item("Survey: Interest to Participate")).Value = "No" And Cells(i, headers.Item("Role")).Value = "MEM" Then
                Cells(i, headers.Item("Role")).Value = "C-MEM"
                Cells(i, headers.Ittem(" Follow-up date")).ClearContents
                Cells(i, headers.Item("REV profile follow-up date")).Value = "N/A"
            ElseIf Cells(i, headers.Item("Survey: Interest to Participate")).Value = "No" And Cells(i, headers.Item("Role")).Value = "VCH" Then
                Cells(i, headers.Item("Role")).Value = "C-VCH"
                Cells(i, headers.Ittem(" Follow-up date")).ClearContents
                Cells(i, headers.Item("REV profile follow-up date")).Value = "N/A"
            End If
        End If
    Next i

End Sub

Answer 1

But this is a shared workbook, so people are adding columns randomly and every time I need to go back to the code and modify the columns refereces.

Protect the workbook to prevent this undesired behavior?

I would personally prefer to use Named Ranges, which will adjust with insertions and re-sorting of the data columns.

From Formulas ribbon, define a new name:

Then, confirm that you can move, insert, etc., with a simple procedure like:

Const ROLE As String = "Role"
Sub foo()

Dim rng As Range

Set rng = Range(ROLE)

' This will display $B$1
MsgBox rng.Address, vbInformation, ROLE & " located:"

rng.Offset(0, -1).Insert Shift:=xlToRight

' This will display $C$1
MsgBox rng.Address, vbInformation, ROLE & " located:"

rng.Cut
Application.GoTo Range("A100")
ActiveSheet.Paste

 ' This will display $A$100
MsgBox rng.Address, vbInformation, ROLE & " located:"  
End Sub

So, I would define a Named Range for each of your columns (presently assumed to be AE, U, Y & AJ). The Named Range can span the entire column, which will minimize changes to the rest of your code.

Given 4 named ranges like:

• Role, representing column U:U
• RevProfile, representing column AJ:AJ
• FollowUp, representing column Y:Y
• Intent, representing column AE:AE

(NOTE: If you anticipate that users may insert rows above your header rows, then I would change the Named range assignments to only the header cells, e.g., "$AE$1", "$U$1", etc. -- this should require no additional changes to the code below)

You could do like this:

'Constant strings representing named ranges in this worksheet
Public Const ROLE As String = "Role"
Public Const REVPROFILE As String = "RevProfile"
Public Const FOLLOWUP As String = "FollowUp"
Public Const INTENT As String = "Intent"

Sub AdjustForNoIntent()
    'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
    Dim lastrow As Long
    Dim i As Long

    lastrow = Range(INTENT).End(xlUp).Row
    For i = 2 To lastrow
        If Not IsError(Range(INTENT).Cells(i).Value) Then
            If Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "MEM" Then
                Range(ROLE).Cells(i).Value = "C-MEM"
                Range(FOLLOWUP).ClearContents
                Range(REVPROFILE).Cells(i).Value = "N/A"
            ElseIf Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "VCH" Then
                Range(ROLE).Cells(i).Value = "C-VCH"
                Range(FOLLOWUP).Cells(i).ClearContents
                Range(REVPROFILE).Value = "N/A"
            End If
        End If
    Next
End Sub

Answer 2

I would go with David Zemens answer but you could also use Range().Find to get the correct columns.

Here I refactored you code to find and set references to your column headers. Everything is based relative to these references.

Here I set a reference to Row 3 of the Survey column where your column header is:

Set rSurvey = .Rows(3).Find(What:="Survey", MatchCase:=False, Lookat:=xlWhole)

Because everything is relative to rSurvey the last row is = the actual last row - rSurvey's row

lastrow = rSurvey(.Rows.Count - rSurvey.Row).End(xlUp).Row - rSurvey.Row

Since rSurvey is a range we know that rSurvey.Cells(1, 1) is our column header. What isn't apparent is that since rSurvey is a range rSurvey(1, 1) is also our column header and since column and row indices are optional rSurvey(1) is also the column header cell.

Know all of that we can iterate over the cells in each column like this

For i = 2 To lastrow 
   rSurvey( i )

---

Sub AdjustForNoIntent()
'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
    Dim lastrow As Long
    Dim i As Long
    Dim rRev As Range    'AJ
    Dim rRole As Range    'U
    Dim rFollowUp As Range    'Y
    Dim rSurvey As Range    'AE
    With Worksheets("Tracking")
        Set rRev = .Rows(3).Find(What:="REV", MatchCase:=False, Lookat:=xlWhole)
        Set rRole = .Rows(3).Find(What:="Role", MatchCase:=False, Lookat:=xlWhole)
        Set rFollowUp = .Rows(3).Find(What:="Follow-up", MatchCase:=False, Lookat:=xlWhole)
        Set rSurvey = .Rows(3).Find(What:="Survey", MatchCase:=False, Lookat:=xlWhole)
        lastrow = rSurvey(.Rows.Count - rSurvey.Row).End(xlUp).Row - rSurvey.Row

    End With

    For i = 2 To lastrow 
        If Not IsError(rSurvey(i).value) Then
            If rSurvey(i).value = "No" And rRole(i).value = "MEM" Then
                rRole(i).value = "C-MEM"
                rFollowUp(i).ClearContents
                rRev(i).value = "N/A"
            ElseIf rSurvey(i).value = "No" And rRole(i).value = "VCH" Then
                rRole(i).value = "C-VCH"
                rFollowUp(i).ClearContents
                rRev(i).value = "N/A"
            End If
        End If
    Next i
End Sub

Answer 3

The way I'd go about this would be to create a Dictionary with header names as keys and column numbers as values:

Dim headers As Dictionary
Set headers = New Scripting.Dictionary

Dim c As Long
'Assuming headers are in row 1 for sake of example...
For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
    headers.Add Cells(1, c).Value, c
Next

Then, instead of using hard-code column letters with the Range, use the Cells collection and index it by column number using the Dictionary to look it up based on the header. For example, if your code expects column "U" to be under that header "Role" here:

Range("U" & i).Value = "C-MEM"

You can replace it with a column lookup like this using the Dictionary like this:

Cells(i, headers.Item("Role")).Value = "C-MEM"

Note that this requires a reference to the Microsoft Scripting Runtime (Tools->References... then check the box).