Insert blank column when value missing from header array

[scott_n_phnx]

I am extracting raw data from another program and importing into Excel 2007. An issue that I have run into is that the ordering is not always correct. I have found a code that will reorder the columns, but I have discovered that sometimes not all of the headers are included in the extract. The data in the columns are not always needed, but it throws off my other formulas and macros when this column is missing. Can anyone suggest a way to search through the header array and when one of the headers is missing, it will insert a blank/empty column? This should ensure that all of the data is aligned properly (I hope).
Here is the code that I am using to reorder, including the array.

Sub Reorder_Columns()
   
    Dim arrColOrder As Variant, ndx As Integer
    Dim Found As Range, counter As Integer
    
    arrColOrder = Array("EventTime(dt)", "Severity(sev)", "EventName(evt)", "Message(msg)", "InitHostDomain(rv42)", "InitHostName(shn)", "InitIP(sip)", "InitUserDomain(rv35)", _
        "InitUserName(sun)", "TargetHostDomain(rv41)", "TargetHostName(dhn)", "TargetIP(dip)", "TargetUserDomain(rv45)", "TargetUserName(dun)", "InitServiceName(sp)", "ExtendedInformation(ei)", "DeviceEventTimeString(et)", "Tags(rv145)")
    
    counter = 1
    Application.ScreenUpdating = False
    For ndx = LBound(arrColOrder) To UBound(arrColOrder)
    
        Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
       If Not Found Is Nothing Then
            If Found.Column <> counter Then
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = False
            End If
            counter = counter + 1
        End If
    Next ndx
    Application.ScreenUpdating = True

End Sub

 

[hiker95]

scott_n_phnx,

Nice macro - one for my archives.

I have added some code that will check for each column title in row 1. If the title is not present, the macro will add the column title.

Then your original code will move the columns to their correct locations.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub Reorder_ColumnsV2()
' hiker95, 12/11/2013
' http://www.mrexcel.com/forum/excel-questions/744531-insert-blank-column-when-value-missing-header-array.html
Dim arrColOrder As Variant, ndx As Integer
Dim Found As Range, counter As Integer
Dim fc As Long, lc As Long, nc As Long

arrColOrder = Array("EventTime(dt)", "Severity(sev)", "EventName(evt)", "Message(msg)", "InitHostDomain(rv42)", "InitHostName(shn)", "InitIP(sip)", "InitUserDomain(rv35)", _
   "InitUserName(sun)", "TargetHostDomain(rv41)", "TargetHostName(dhn)", "TargetIP(dip)", "TargetUserDomain(rv45)", "TargetUserName(dun)", "InitServiceName(sp)", "ExtendedInformation(ei)", "DeviceEventTimeString(et)", "Tags(rv145)")

counter = 1
Application.ScreenUpdating = False

For ndx = LBound(arrColOrder) To UBound(arrColOrder)
  fc = 0
  On Error Resume Next
  fc = Application.Match(arrColOrder(ndx), Rows(1), 0)
  On Error GoTo 0
  If fc = 0 Then
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    If lc = 1 And Cells(1, 1) = "" Then
      lc = 0
    End If
    Cells(1, lc + 1) = arrColOrder(ndx)
    Columns(lc + 1).AutoFit
  End If
Next ndx

For ndx = LBound(arrColOrder) To UBound(arrColOrder)
  Set Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
    SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
  If Not Found Is Nothing Then
    If Found.Column <> counter Then
      Found.EntireColumn.Cut
      Columns(counter).Insert Shift:=xlToRight
      Application.CutCopyMode = False
    End If
    counter = counter + 1
  End If
Next ndx
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the Reorder_ColumnsV2 macro.

 

[scott_n_phnx]

That is perfect. Thank you very much.

 

[hiker95]

scott_n_phnx,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.