Excel VBA Application.Match error handling and messaging - vba

Question

I'm trying to store data from Excel sheet into an array.
The data looks like this:
The code I use:
Sub StoreData()
Dim Data() As String
'Count number of Line in Sheet1
Sheet1_size = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
'Array to store data
ReDim Data(1 To Sheet1_size - 1, 1 To 6) As String
'storing data into array
For i = 1 To Sheet1_size - 1
With Worksheets("Sheet1")
Data(i, 1) = .Cells(i + 1, Application.Match("Name", .Rows(1), 0))
Data(i, 2) = .Cells(i + 1, Application.Match("Sex", .Rows(1), 0))
Data(i, 3) = .Cells(i + 1, Application.Match("Age", .Rows(1), 0))
Data(i, 4) = .Cells(i + 1, Application.Match("Nationality", .Rows(1), 0))
Data(i, 5) = .Cells(i + 1, Application.Match("License", .Rows(1), 0))
Data(i, 6) = .Cells(i + 1, Application.Match("Hand", .Rows(1), 0))
End With
Next i
End Sub
Everything works perfectly when the sheet1 looks like above.
However, order and number of columns may differ each time in sheet1. For example it might be: Name Age Nationality or Name License Hand Sex Age Nationality or Nationality Age and etc. This table is filled in by people so they may forget to include some variables.
If any column is missing I get an error below:
What I'd like to to is to show message/message box with the name of column which is missing instead of this error. If there are several missing columns I'd like to message all the missing names.
Disabling errors is not a solution because there are no messages delivered on screen. Any solutions?

Answer 1

Here is the solution I'd propose:
Option Explicit
Option Compare Text
Public Sub StoreData()
Dim ws As Worksheet
Dim Data As Variant
Dim LastRow As Long, LastColumn As Long
Dim nColumn As Long, RequirementCount As Long, CheckCount As Long
Dim RequirementList() As String, ErrorMessage As String
'Determine the range
Set ws = ThisWorkbook.Worksheets("Sheet1")
LastRow = ws.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = ws.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
'Range to array
Data = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, LastColumn)).Value2
'Set requirements
RequirementList = Split("Name|Nationality|Age|License|Hand|Sex", "|")
'Compare all available columns against the requirements
For nColumn = 1 To UBound(Data, 2)
For RequirementCount = LBound(RequirementList) To UBound(RequirementList)
If Data(1, nColumn) = RequirementList(RequirementCount) Then
RequirementList(RequirementCount) = vbNullString
CheckCount = CheckCount + 1
End If
Next RequirementCount
Next nColumn
'If less then the required 6 columns were found then pass a message box to the user telling him/her about it
If CheckCount <> 6 Then
ErrorMessage = "The following columns are missing:" & Chr(10)
For RequirementCount = LBound(RequirementList) To UBound(RequirementList)
ErrorMessage = ErrorMessage & IIf(RequirementList(RequirementCount) = vbNullString, "", " -" & RequirementList(RequirementCount) & Chr(10))
Next RequirementCount
MsgBox ErrorMessage
Else
MsgBox "All columns are accounted for and ready for import."
End If
End Sub
Check out the comments in the code for more information. Also, note the importance of Option Compare Text at the top of the code to ensure that Age = age = aGe, etc.