Validating column Heads

[lucpian]

Hi All,

I am having a big problem with the code I wrote to import text files into Excel. It works fine, but as part of the requirement it should validate that the following column headings are there, and appears in the following order: First_Name, Last_Name, Purch_Ord_Num, Amount, Purc_Date, Received_By, Verified_By.

Here is the code,

Sub ImportTextFile()

Dim sFile As String
Dim sInput As String
Dim lFNum As Long
Dim vaFields As Variant
Dim i As Long
Dim lRow As Long
Dim vaStrip As Variant
Dim FileName As Variant
Dim Sep As String
Application.ScreenUpdating = False
On Error GoTo EndMacro:
lFNum = FreeFile

sFile = Application.GetOpenFilename(FileFilter:="Excel File (*.txt),*.txt")
'If sFile = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
' Exit Sub
'End If
Const sDELIM = "," 'Set the delimeter

lFNum = FreeFile
'sFile = "C:CaratDelim.txt"
vaStrip = Array(vbLf, vbTab) 'list the text to strip

'Open the file
Open sFile For Input As lFNum

'Loop through the file until the end
Do While Not EOF(lFNum)
Line Input #lFNum, sInput 'input the current line

'remove the unwanted text
For i = LBound(vaStrip) To UBound(vaStrip)
sInput = Replace(sInput, vaStrip(i), " ")
Next i

'split the text based on the delimeter
vaFields = Split(sInput, sDELIM)
lRow = lRow + 1

'Write to the worksheet
For i = 0 To UBound(vaFields)
Sheet1.Cells(lRow, i + 1).Value = vaFields(i)
Next i
Loop



EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close lFNum

End Sub

I have tried writing codes to add to it to do it but it is not working. I would be very grateful if someone in this forum will help me out.

Thanks

Lucpian

Edit Lucas: VBA Tags added: Lucipian, when posting your code select it and hit the VBA button...

[lucas]

Can you put your header row in using an array and then import your text file?


Dim myarray As Variant
myarray = Array("Heading 1", "Heading 2", "Heading 3", "Heading 4", "Heading 5")
Range("a1:e1").Value = myarray

[Bob Phillips]

Sub ImportTextFile()

Dim sFile As String
Dim lFNum As Long
Dim vaFields As Variant
Dim i As Long
Dim lRow As Long
Dim vaStrip As Variant
Dim FileName As Variant
Dim Sep As String

Application.ScreenUpdating = False
On Error GoTo EndMacro:
lFNum = FreeFile

sFile = Application.GetOpenFilename(FileFilter:="Excel File (*.txt),*.txt")
'If sFile = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
' Exit Sub
'End If
Const sDELIM = "," 'Set the delimiter

lFNum = FreeFile
'sFile = "C:CaratDelim.txt"
vaStrip = Array(vbLf, vbTab) 'list the text to strip

'Open the file
Open sFile For Input As lFNum

vaFields = GetData(lFNum, vaStrip, sDELIM)
i = LBound(vaFields)
If UBound(vaFields) - i + 1 = 7 Then

If vaFields(i) = "First_Name" And _
vaFields(i + 1) = "Last_Name" And _
vaFields(i + 2) = "Purch_Ord_Num" And _
vaFields(i + 3) = "Amount" And _
vaFields(i + 4) = "Purc_Date" And _
vaFields(i + 5) = "Received_By" And _
vaFields(i + 6) = "Verified_By" Then

'Loop through the file until the end
Do While Not EOF(lFNum)

vaFields = GetData(lFNum, vaStrip, sDELIM)
lRow = lRow + 1

'Write to the worksheet
For i = 0 To UBound(vaFields)
Sheet1.Cells(lRow, i + 1).Value = vaFields(i)
Next i
Loop
Else

MsgBox "Invalid headers"
End If
Else

MsgBox "Invalid headers"
End If

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close lFNum

End Sub

Private Function GetData(ByVal FileNum As Long, _
ByVal Redundant As Variant, _
ByVal Delimiter As String) As Variant
Dim sInput As String
Dim i As Long

Line Input #FileNum, sInput 'input the current line
'remove the unwanted text
For i = LBound(Redundant) To UBound(Redundant)
sInput = Replace(sInput, Redundant(i), " ")
Next i

'split the text based on the delimeter
GetData = Split(sInput, Delimiter)
End Function