Hello! I have a code that is almost working, but I need some help getting the last bit. I am essentially trying to ensure that I have a consistent set of columns, in a specified order. Sometimes when we export a report from our financial tool, it doesn't give us all the columns we need, so this is our work around. We need the exact same columns in this specific order.
The code below works, except it is inserting the missing columns at the end, rather than inserting them in the correct order. Any ideas as to how I can modify this so that it inserts the missing column in the correct order, and not just at the end? Thank you!!
The code below works, except it is inserting the missing columns at the end, rather than inserting them in the correct order. Any ideas as to how I can modify this so that it inserts the missing column in the correct order, and not just at the end? Thank you!!
VBA Code:
Sub AddMissingColumns()
Dim ws As Worksheet
Dim requiredColumns As Variant
Dim columnName As Variant
Dim foundColumn As Range
Dim insertIndex As Long
Dim lastColumn As Long
Dim i As Long
' Set the worksheet to work with (Active Sheet)
Set ws = ActiveSheet
' Define the required columns in the desired order
requiredColumns = Array("Client", "Job", "Job description", "Job Phase", "Phase description", "Job Status", "Booked Charge", "Ticketed Hours", "Time Actual Charge", "PO Actual Charge", "PO Estimate Charge", "Exp Actual Charge", "Exp Estimate Charge", "Billing Plan - Planned Value (Invoicing)", "Billing Plan - Recognise Value", "Billing Plan - Notional Costs (Disbursements)", "Billing Plan - Profit Forecast (Fee Revenue)") ' Replace with the column names you expect
' Find the last column in the worksheet
lastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).column
' Loop through the required columns
For i = LBound(requiredColumns) To UBound(requiredColumns)
columnName = requiredColumns(i)
' Check if the column exists
Set foundColumn = Nothing
On Error Resume Next
Set foundColumn = ws.Rows(1).Find(columnName, LookIn:=xlValues, LookAt:=xlWhole)
On Error GoTo 0
' If the column doesn't exist, insert it at the specified index
If foundColumn Is Nothing Then
insertIndex = lastColumn + 1
ws.Columns(insertIndex).Insert Shift:=xlToRight
ws.Cells(1, insertIndex).Value = columnName
lastColumn = lastColumn + 1
ElseIf foundColumn.column > i + 1 Then
' If the column is found but not at the correct index, move it to the correct index
foundColumn.EntireColumn.Cut ws.Columns(i + 1)
lastColumn = lastColumn - 1
End If
Next i
End Sub
