vba move columns code example
Example: vba move column header
Sub MoveColumnWithSpecifiedHeader(sHeaderName As String, sColAsLetter As String)
Dim sFunct As String: sFunct = "MoveColumnWithSpecifiedHeader"
Dim bDebugging As Boolean: bDebugging = True
If (bDebugging = True) Then
Debug.Print Format(DateTime.Now, "hh:mm:ss") & " INFO " & sFunct & "| " _
& "Running.. [sHeaderName:" & sHeaderName & "][sColAsLetter:" & sColAsLetter & "]"
End If
Dim wbInit As Workbook: Set wbInit = ActiveWorkbook
Dim wsInit As Worksheet: Set wsInit = ActiveSheet
Dim s_rInit As String: s_rInit = Selection.Address
Dim sErrMsg As String
Dim rSrcCell As Range
Dim rSrcCol As Range
Dim rDestCol As Range
Dim bCheckCase As Boolean
Dim iInsertShift As Integer
Application.ScreenUpdating = False
bCaseIsNB = False
iInsertShift = xlShiftToLeft
Set rSrcCell = wsInit.UsedRange.Find _
(sHeaderName, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=bCaseIsNB)
If (Len(sColAsLetter) <> 1) Then
sErrMsg = sErrMsg & vbNewLine _
& "sColAsLetter of """ & sColAsLetter & """ is not valid. It can only have one letter"
Err.Raise -1
End If
If (rSrcCell Is Nothing) Then
sErrMsg = sErrMsg & vbNewLine _
& "No text found containing the text of """ & sHeaderName & """"
Err.Raise -1
End If
Set rDestCol = Range(sColAsLetter & "1").EntireColumn
Set rSrcCol = rSrcCell.EntireColumn
If (bDebugging = True) Then
Debug.Print Format(DateTime.Now, "hh:mm:ss") & " INFO " & sFunct & "| " _
& "Source cell with """ & sHeaderName & """ found " _
& "at cell [" & rSrcCol.Address & "]"
End If
If (rSrcCol.EntireColumn.Address = rDestCol.Address) Then
GoTo Sub_Complete
End If
rSrcCol.Cut
rDestCol.Insert Shift:=iInsertShift
Sub_Complete:
Application.CutCopyMode = False
wbInit.Activate
wsInit.Activate
Range(s_rInit).Select
If (bDebugging = True) Then
Debug.Print Format(DateTime.Now, "hh:mm:ss") & " INFO " & sFunct & "| " _
& "Complete [if not debugging, make bDebugging = false]"
End If
Application.ScreenUpdating = True
Exit Sub
ErrHandling:
Application.ScreenUpdating = True
Debug.Print Format(DateTime.Now, "hh:mm:ss") & " INFO " & sFunct & "| " _
& " -> Failed"
MsgBox _
Title:="Errors in the function: " & sFunct _
, Prompt:=Err.Description _
& vbNewLine & sErrMsg _
, Buttons:=vbCritical
End Sub