Search column headers and insert new column using

Question

I have a spreadsheet that is updated regularly. Therefore the column header positions change regularly. eg. today "Username" is column K, but tomorrow "Username" might be column L. I need to add a new column to the right of "Username" but where it changes I cannot refer to as cell/column reference.

So far I have:

Dim rngUsernameHeader As Range
Dim rngHeaders As Range
Set rngHeaders = Range("1:1") 'Looks in entire first row.
Set rngUsernameHeader = rngHeaders.Find("Username")

When I go to add a new column to the right of it, I'm selecting that row but it's going back to cell/column references...

Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("K1").Select
ActiveCell.FormulaR1C1 = "Role"

How can I perform this step with a macro?

edit: I think need to give that Column a header name and begin populating the row with data - each time I do begins the cell references which I want to avoid wherever possible.

Many thanks in advance.

Answer 1

Something like this should work. The idea is that you locate the column and then you insert to the right. That is why you have the +1 in the TestMe. The function l_locate_value_col returns the column, where it has found the value. If you want, you may change the optional parameter l_row, depending on which row do you want to look for.

Option Explicit

Public Sub TestMe()

    Dim lngColumn         As Long

    lngColumn = l_locate_value_col("Username", ActiveSheet)
    Cells(1, lngColumn + 1).EntireColumn.Insert

End Sub

Public Function l_locate_value_col(target As String, _
                                    ByRef target_sheet As Worksheet, _
                                    Optional l_row As Long = 1)

    Dim cell_to_find                As Range
    Dim r_local_range               As Range
    Dim my_cell                     As Range

    Set r_local_range = target_sheet.Range(target_sheet.Cells(l_row, 1), target_sheet.Cells(l_row, Columns.Count))

    For Each my_cell In r_local_range
        If target = Trim(my_cell) Then
            l_locate_value_col = my_cell.Column
            Exit Function
        End If
    Next my_cell

    l_locate_value_col = -1

End Function

Answer 2

How about:

Sub qwerty()
    Dim rngUsernameHeader As Range
    Dim rngHeaders As Range

    Set rngHeaders = Range("1:1") 'Looks in entire first row.
    Set rngUsernameHeader = rngHeaders.Find(what:="Username", After:=Cells(1, 1))

    rngUsernameHeader.Offset(0, 1).EntireColumn.Insert
    rngUsernameHeader.Offset(0, 1).Value = "role"
End Sub

Answer 3

You could name your range:

Sub Test()

    Dim rngUsernameHeader As Range
    'UserName is in column F at the moment.
    Set rngUsernameHeader = Range("UserName")
    Debug.Print rngUsernameHeader.Address 'Returns $F$1
    ThisWorkbook.Worksheets("Sheet2").Range("E:E").Insert Shift:=xlToRight
    Debug.Print rngUsernameHeader.Address 'Returns $G$1

End Sub

Edit: Have rewritten so it inserts a column after your named column and returns that reference:

Sub Test()

    Dim rngUsernameHeader As Range
    Dim rngMyNewColumn As Range

    Set rngUsernameHeader = Range("UserName")
    rngUsernameHeader.Offset(, 1).Insert Shift:=xlToRight

    'You'll need to check the named range doesn't exist first.
    ThisWorkbook.Names.Add Name:="MyNewRange", _
        RefersTo:="='" & rngUsernameHeader.Parent.Name & "'!" & _
                         rngUsernameHeader.Offset(, 1).Address

    Set rngMyNewColumn = Range("MyNewRange")
    MsgBox rngMyNewColumn.Address

End Sub

Answer 4

Sub AddColumn
    Dim cl as Range

    For each cl in Range("1:1")
        If cl = "username" Then
           cl.EntireColumn.Insert Shift:= xlToRight
        End If

        cl.Offset(0, 1) = "role"
    Next cl
End Sub

Untested code as not at my desktop