Question

I’m currently having a data validation problem in Excel and may be the victim of “over-thinking” the problem.

My requirement is simple – I receive a large amount of xls files which all need to comply to an exact format.

For example, I need all of the files I receive to have have the following strings in cells A1 to A3: “FirstName”, “LastName”, “Email”. (Case matters).

In reality, there are a lot more headers than this and trawling through every file and ensuring that all of the headings exist and are spelt correctly/in the correct case is very tedious and time consuming. I believe that it would be possible to create a module or tool in Visual Basic which could check the format and then return either correct/false based on whether the file complies with the required format.

I have looked into regular expressions (but believe that this may be overkill as I only require EXACT matches) and have no experience in using VB. I have looked online for help – some of which has been useful, some of which has be way too advanced for the tool I need.

Any help is greatly appreciated.

Thanks.

Answer 1

Do the following if you are using Windows:

1. Copy the code below into a file and name it with a *.vbs extension eg. “ExcelHeader.vbs”, and save it somewhere eg. on your desktop
2. Put all your Excel files that you want to check headers with in a folder
3. Double-click the .vbs file, and select that folder when prompted

The script will then run through the folder and tell you which files are not conforming to your header requirements.

(you can also modify the code below to include more headers, it should be obvious from my comments below in the “Else If” part).

Dim sFolder, fso, files, folder, objExcel, objWorkbook

 sFolder = SelectFolder( "" )
 If sFolder = vbNull Then
     WScript.Echo "Cancelled"
 Else
     WScript.Echo "Selected Folder: """ & sFolder & """"
 End If

 ' use strPath to look for excel files list
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set folder = fso.GetFolder(sFolder)
 Set files = folder.Files

 Set objExcel = CreateObject("Excel.Application")

 For Each file In files

    Set objWorkbook = objExcel.Workbooks.Open(file)

' add more headers as you wish as ElseIf statements below

    If objExcel.Cells(1, 1).Value <> "FirstName" Then
        MsgBox(file & " is not correct.")
    ElseIf objExcel.Cells(1, 2).Value <> "LastName" Then
            MsgBox(file & " is not correct.")
    ElseIf objExcel.Cells(1, 3).Value <> "Email" Then
            MsgBox(file & " is not correct.")
    End If

    objExcel.ActiveWorkbook.Close(0)

Next

objExcel.Quit


 Function SelectFolder( myStartFolder )
 ' This function opens a "Select Folder" dialog and will
 ' return the fully qualified path of the selected folder
 '
 ' Argument:
 '     myStartFolder    [string]    the root folder where you can start browsing;
 '                                  if an empty string is used, browsing starts
 '                                  on the local computer
 '
 ' Returns:
 ' A string containing the fully qualified path of the selected folder
 '
 ' Written by Rob van der Woude
 ' http://www.robvanderwoude.com

     ' Standard housekeeping
     Dim objFolder, objItem, objShell

     ' Custom error handling
     On Error Resume Next
     SelectFolder = vbNull

     ' Create a dialog object
     Set objShell  = CreateObject( "Shell.Application" )
     Set objFolder = objShell.BrowseForFolder( 0, "Select Folder", 0, myStartFolder )

     ' Return the path of the selected folder
     If IsObject( objfolder ) Then SelectFolder = objFolder.Self.Path

     ' Standard housekeeping
     Set objFolder = Nothing
     Set objshell  = Nothing
     On Error Goto 0

 End Function

 Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader )
' Function :  ReadExcel
' Version  :  2.00
' This function reads data from an Excel sheet without using MS-Office
'
' Arguments:
' myXlsFile   [string]   The path and file name of the Excel file
' mySheet     [string]   The name of the worksheet used (e.g. "Sheet1")
' my1stCell   [string]   The index of the first cell to be read (e.g. "A1")
' myLastCell  [string]   The index of the last cell to be read (e.g. "D100")
' blnHeader   [boolean]  True if the first row in the sheet is a header
'
' Returns:
' The values read from the Excel sheet are returned in a two-dimensional
' array; the first dimension holds the columns, the second dimension holds
' the rows read from the Excel sheet.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    Dim arrData( ), i, j
    Dim objExcel, objRS
    Dim strHeader, strRange

    Const adOpenForwardOnly = 0
    Const adOpenKeyset      = 1
    Const adOpenDynamic     = 2
    Const adOpenStatic      = 3

    ' Define header parameter string for Excel object
    If blnHeader Then
        strHeader = "HDR=YES;"
    Else
        strHeader = "HDR=NO;"
    End If

    ' Open the object for the Excel file
    Set objExcel = CreateObject( "ADODB.Connection" )
    ' IMEX=1 includes cell content of any format; tip by Thomas Willig
    objExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
                  myXlsFile & ";Extended Properties=""Excel 8.0;IMEX=1;" & _
                  strHeader & """"

    ' Open a recordset object for the sheet and range
    Set objRS = CreateObject( "ADODB.Recordset" )
    strRange = mySheet & "$" & my1stCell & ":" & myLastCell
    objRS.Open "Select * from [" & strRange & "]", objExcel, adOpenStatic

    ' Read the data from the Excel sheet
    i = 0
    Do Until objRS.EOF
        ' Stop reading when an empty row is encountered in the Excel sheet
        If IsNull( objRS.Fields(0).Value ) Or Trim( objRS.Fields(0).Value ) = "" Then Exit Do
        ' Add a new row to the output array
        ReDim Preserve arrData( objRS.Fields.Count - 1, i )
        ' Copy the Excel sheet's row values to the array "row"
        ' IsNull test credits: Adriaan Westra
        For j = 0 To objRS.Fields.Count - 1
            If IsNull( objRS.Fields(j).Value ) Then
                arrData( j, i ) = ""
            Else
                arrData( j, i ) = Trim( objRS.Fields(j).Value )
            End If
        Next
        ' Move to the next row
        objRS.MoveNext
        ' Increment the array "row" number
        i = i + 1
    Loop

    ' Close the file and release the objects
    objRS.Close
    objExcel.Close
    Set objRS    = Nothing
    Set objExcel = Nothing

    ' Return the results
    ReadExcel = arrData
End Function

P.S. Thanks to Rob van der Woude for the bottom Function 🙂