Check Header is in correct order

[Jak]

Hi All

Looking for a bit of VB code to act as an error checker. I need to check that my header row titles Row 1 are is in the correct order i.e.

[A1] = "Forename"
[B1] = "Initial"
[C1] = "Surname"
[D1] = "DOB"
[E1] = "Ethnicity"
[F1] = "Gender"
[G1] = "Centre Candidate ID."

If they are not then - MsgBox "Please run Sort Columns Button",48,"Error detected"

Thanks in advance

 

[erik.van.geit]

Hi, jak,

did yoy try something like this ?

If [A1] <> "Forename" Or [B1] <> "Initial" Or [C1] <> "Surname" _
Or [D1] <> "DOB" Or [E1] <> "Ethnicity" Or [F1] <> "Gender" _
Or [G1] <> "Centre Candidate ID." Then MsgBox "Please run Sort Columns Button",48,"Error detected"

kind regards,
Erik

 

[erik.van.geit]

although ...
I would prefer this

Sub test()
Dim headerArray As Variant
Dim i As Integer

headerArray = Array("Forename", "Initial", "Surname", "DOB", "Ethnicity", "Gender", "Centre Candidate ID")

    For i = 0 To UBound(headerArray)
        If Cells(1, i + 1) <> headerArray(i) Then
        MsgBox "Please run Sort Columns Button", 48, "Error detected"
        Exit Sub 'Exit For
        End If
    Next i


End Sub

even better would be to do the sort within the code

 

[Jak]

Hi Erik

Many thanks for the two posts. I have gone with the second offering, Tested and working perfectly. Thanks so much for the assist.

 

[erik.van.geit]

you're most WELCOME !

wouldn't it be intresting to do the sort within the code ?
if so provide an example of what the sort would look like (though I can imagine)

 

[Jak]

Hello Erik

The code you helped me out with is to error trap the header row not being in the correct order before saving the worksheet. The user is then prompted to run the sort code though I could simply get the save code to fire the sort code instead of using a MsgBox to flag the error. Heres the code I am using for the sort header row devised by acw MVP board member which was tweaked to error trap duplicates.

Sub Sorted()

Dim v As Variant, res As Variant
Dim rng As Range, s As String
Dim i As Long
v = Array("Forename", _
         "Initial", _
         "Surname", _
         "DOB", _
         "Ethnicity", _
         "Gender", _
         "Centre Candidate ID.")
With ActiveSheet 'With Worksheets("Sheet1")
 Set rng = .Range(.Cells(1, 1), _
  .Cells(1, Columns.Count).End(xlToLeft))
End With

For i = LBound(v) To UBound(v)
 res = Application.Match(v(i), rng, 0)
 If IsError(res) Then
   s = s & v(i) & ", "
 End If
Next
If Len(Trim(s)) > 0 Then
 s = Left(s, Len(s) - 2)
 MsgBox "Missing headers: " & vbNewLine _
   & s, 48, "Mandatory Header Check"
   Else: GoTo DupChk:

End If
Exit Sub

'check for duplicate headers
DupChk:
 
 Dim firstCell As Range, lastCell As Range
 Dim cellCompare As Range, rngCompareTo As Range
 Dim cellComareTo As Range
 Set firstCell = Range("a1")
 Set lastCell = firstCell.SpecialCells(xlCellTypeLastCell)
 Set lastCell = Cells(1, lastCell.Column)
 For Each cellCompare In Range(firstCell, _
   lastCell.Offset(0, -1)).Cells
   If cellCompare <> "" Then
     Set rngCompareTo = _
       Range(cellCompare.Offset(0, 1), lastCell)
     For Each cellCompareTo In rngCompareTo.Cells
       If cellCompareTo = cellCompare Then
        MsgBox "There's a duplicate Header in row 1." & vbCrLf & vbCrLf & _
"Please delete and run Sort NCFE Mandatory Headers by Column Button", 48, "Duplicate Check"
         Exit Sub
       End If
     Next cellCompareTo
   End If
 Next cellCompare

  Application.ScreenUpdating = False
  KeepArr = Array("Forename", "Initial", "Surname", "DOB", "Ethnicity", "Gender", "Centre Candidate ID.")
  For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
    holder = 0
    On Error Resume Next
    holder = WorksheetFunction.Match(Cells(1, i), KeepArr, 0)
    On Error GoTo 0
    If holder = 0 Then Cells(1, i).EntireColumn.Delete
  
  Next i
  Rows("1:1").Insert
  lastcol = Cells(2, Columns.Count).End(xlToLeft).Column
  For i = 1 To lastcol
   Cells(1, i).Value = WorksheetFunction.Match(Cells(2, i), KeepArr, 0)
  Next i
  Range("a1", Cells(1, lastcol)).EntireColumn.Sort key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
  Rows("1:1").Delete
  Range("A1").Select
  
  Run "MakeLegible"
  Application.ScreenUpdating = True
End Sub

 

[erik.van.geit]

o, fine! you have already what you need