How to find matching headers in a worksheet using VBA? - excel

Question

There is a sheet with headers. Out of those headers I have to verify/check that 12 headers are available. If they are available message should show as success and if not it should show that the specific header is missing.
I created a sub and took an array with those twelve values but how to match?

Answer 1

Please test the next code. You will build the headers array in a way to reflect your reality:
Sub testCheckHeadersArray()
Dim sh As Worksheet, arrH As Variant, El As Variant, C As Range
Dim boolFound As Boolean, strNotFound As String, lastCol As Long
arrH = Split("Header1,Header3,Header4,Header5,Header6,Header7,Header8,Header9,Header10", ",")
Set sh = ActiveSheet 'please, use here your sheet to be checked
lastCol = sh.Cells(1, Cells.Columns.Count).End(xlToLeft).column
For Each El In arrH
boolFound = False
For Each C In sh.Range(sh.Cells(1, 1), sh.Cells(1, lastCol))
If UCase(El) = UCase(C.value) Then
boolFound = True: Exit For
End If
Next
If Not boolFound Then strNotFound = strNotFound & El & vbCrLf
Next
If strNotFound <> "" Then
MsgBox "The next headers have not been found:" & vbCrLf & strNotFound
Else
MsgBox "Everything OK"
End If
End Sub
If you have a sheet with the correct headers, you can extract the array from there:
Set shH = Worksheets("HeaderModel")
arrH = shH.Range(Range("A1"), shH.Cells(1, shH.Cells(1, _
Cells.Columns.Count).End(xlToLeft).column)).value

Answer 2

This is how you might tackle your problem. Please read the comments in the code to understand how it's done.
Option Explicit
Sub TestHeaderPresence()
Dim CheckHeaders As Variant
Dim Headers As String
' list the required headers
Headers = "Header1,Header3,Header4,Header5,Header6,Header7,Header8," & _
"Header9,Header10,Header11,Header12"
' pass the list to the function
CheckHeaders = HeadersArePresent(Headers)
If CheckHeaders = True Then
MsgBox "All headers are present.", vbInformation, "Caption check"
Else
MsgBox "At least caption """ & CheckHeaders & """" & " is missing.", _
vbInformation, "Caption check"
End If
End Sub
Function HeadersArePresent(Headers As String) As Variant
Dim Fun As String ' function return
Dim Captions() As String
Dim HeaderRange As Range
Dim HeaderArray As Variant
Dim Tmp As Variant
Dim i As Long
With ActiveSheet ' replace with "With Worksheets("[tab name]")"
' Available Captions start from column "C" in row "1"
' modify as appropriate
Tmp = .Range(.Cells(1, "C"), .Cells(1, .Columns.Count).End(xlToLeft)).Value
End With
ReDim HeaderArray(1 To UBound(Tmp, 2))
For i = 1 To UBound(Tmp, 2)
HeaderArray(i) = Tmp(1, i)
Next i
HeaderArray = Join(HeaderArray, ",")
Captions = Split(Headers, ",")
For i = 0 To UBound(Captions)
If InStr(HeaderArray, Captions(i)) = 0 Then
Fun = Captions(i)
Exit For
End If
Next i
' return True or the name of first missing header
HeadersArePresent = IIf(Len(Fun), Fun, True)
End Function

Answer 3

Approach via Filter() function
After defining the set of regular headers (~> [0]) and current headers (~> [1]), the Filter() function allows to reduce the initially full set of headers subsequently by the next current header via the 3rd include argument set to False (~> section [2]).
See MS Help: If include is False, Filter returns the subset of the array that does not contain match as a substring
Sub ListMissingHeaders()
'[0] define needed headers and assign them to 1-dim array
Const HEADERLIST = "Header1,Header3,Header4,Header5,Header6,Header7,Header8,Header9,Header10"
Dim regularHeaders: regularHeaders = Split(HEADERLIST, ",")
'[1] get current headers
With Sheet1 ' << change to actual sheet's Code(Name)
Dim lastCol As Long ' get last column in head line
lastCol = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column
Dim currHeaders ' assign current headers to 2-dim array
currHeaders = .Range("1:1").Resize(columnsize:=lastCol)
End With
'[2] Filter regular set of headers passed to array missingHeaders
Dim i As Long, missingHeaders
missingHeaders = regularHeaders ' start with complete set of headers
For i = 1 To UBound(currHeaders, 2) ' filter out existing headers one by one
missingHeaders = Filter(missingHeaders, currHeaders(1, i), False, vbTextCompare)
Next i
'[3] show missing headers
Debug.Print UBound(missingHeaders) + 1 & " missing Headers: """ & _
Join(missingHeaders, """, """)
End Sub