Check Header is in correct order

Jak

Well-known Member
Joined
Apr 5, 2002
Messages
807
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
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
Hi, jak,

did yoy try something like this ?
Code:
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

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832
although ...
I would prefer this
Code:
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

Well-known Member
Joined
Apr 5, 2002
Messages
807
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. :biggrin:
 

erik.van.geit

MrExcel MVP
Joined
Feb 1, 2003
Messages
17,832

ADVERTISEMENT

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

Well-known Member
Joined
Apr 5, 2002
Messages
807
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.


Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,993
Messages
5,526,118
Members
409,685
Latest member
Bellybb

This Week's Hot Topics

Top