Change header row and return last 3 characters

Question

I'm currently reorganizing some columns using VBA code and I need to make a change to one of the header rows and the values in 1 specific column. I've included what I'm basically trying to do in a comment. Here is the code I'm using but very cut down for brevity.

Sub columnOrder2()
Dim search As Range
Dim cnt As Integer
Dim colOrdr As Variant
Dim indx As Integer

colOrdr = Array("User name", "LanID", "Asset Tag")
cnt = 1


For indx = LBound(colOrdr) To UBound(colOrdr)
    Set search = Rows("1:1").Find(colOrdr(indx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
   ' If search = "LanID" then change header row to "Last3"
   ' and return only the last 3 characters for values in cells
    If Not search Is Nothing Then
        If search.Column <> cnt Then
            search.EntireColumn.Cut
            Columns(cnt).Insert Shift:=xlToRight
            Application.CutCopyMode = False
        End If
    cnt = cnt + 1
    End If
Next indx
End Sub

Currently, I'm just running the code and manually renaming the column then creating a formula in cell g2 and using =Right(G2,3) and copying it down to the rest of the cells in column C. I know VBA can do this much better and maybe even just in a separate function. Any help would be appreciated. I haven't worked with Excel VBA for awhile now.

Answer 1

Assuming you mean to overwrite the LANId column with its own last three characters, you could code as follows (C2 instead of G2 in your question?):

Modified code close to OP

Includes a fully qualified (worksheet) range reference, btw (as otherwise VBA assumes any currently active worksheet) :-)

Sub columnOrder2()
Dim ws As Worksheet: Set ws = Sheet1   ' << Using e.g. the sheet's Code(Name)
Dim colOrdr As Variant
colOrdr = Array("User name", "LanID", "Asset Tag")
Dim cnt     As Long
cnt = 1
Dim indx    As Long
For indx = LBound(colOrdr) To UBound(colOrdr)
    Dim search  As Range
    Set search = ws.Rows("1:1").Find(colOrdr(indx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    
    If Not search Is Nothing Then
    
        If LCase(search.Text) = "lanid" Then
            'set column range object to memory
            Dim rng As Range
            Set rng = getColRange(ws, search.Column, Startrow:=1)
            'return only the last 3 characters
            rng.Value = Evaluate("=Right(" & rng.Address & ",3)")
            'change header cell from "LANId" to "Last3"
            rng(1, 1) = "Last3"     ' change header from LANId to Last3
        End If
        
        If search.Column <> cnt Then
            search.EntireColumn.Cut
            Columns(cnt).Insert Shift:=xlToRight
            Application.CutCopyMode = False
        End If
        cnt = cnt + 1
    End If
Next indx

End Sub

Help function

Returns the range of a given sheet column up to the last row with a value:

Function getColRange(mySheet As Worksheet, _
                     Optional ByVal myColumn As Variant = "A", _
                     Optional ByVal Startrow As Long = 1) As Range
With mySheet
'a) change numeric column number to letter(s)
    If IsNumeric(myColumn) Then myColumn = Split((.Columns(myColumn).Address(, 0)), ":")(0)
'b) get last row in given column
    Dim lastRow As Long
    lastRow = .Range(myColumn & .Rows.Count).End(xlUp).Row
'c) return data range as function result
'   (a Range is an Object and has to be SET!)
    Set getColRange = .Range(myColumn & Startrow & ":" & myColumn & lastRow)
End With
End Function

Related link

Instead of moving entire columns one after the other you might be interested in an array approach - c.f. Delete an array column and change position of two columns