VBA: importing from XLS, skipping files

[Emperor]

Hi All,

I'm working with a database of Excel files.
With my code I extract all the data which I need, put it in rows in my mastersheet (Master.XLS) close the file and loop to the next file in the folder. Everything works fine!

However, I would like to skip certain files when they meet one of my two conditions.

- Condition 1; when there is no data in B6, skip file
- Condition 2; somewhere in row A there is a cell called "Totall sum", in a Offset (0,10) there should be data, when not, skip file

My code;

Option Explicit
Sub RunCodeOnAllXLSFiles()
Dim wsResults As Worksheet
Dim wbData As Workbook
Dim Subjects As Range
Dim Subj As Range
Dim subjFIND As Range
Dim fPath As String
Dim fName As String
Dim NR As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
fPath = "N:\path\"            
fName = Dir(fPath & "*.xls")    'start a list of filenames
Set wsResults = ThisWorkbook.Sheets("Blad1")
With wsResults
    NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
 
    Set Subjects = .Range("H2:CA2")
    On Error Resume Next
 
    Do While Len(fName) > 0         'run loop until no more files found
        Set wbData = Workbooks.Open(fPath & fName)
 
        .Range("A" & NR) = fName
        .Range("B" & NR).Value = ActiveSheet.[B3].Value    
        .Range("C" & NR).Value = ActiveSheet.[B4].Value    
        .Range("D" & NR).Value = ActiveSheet.[B5].Value    
        .Range("E" & NR).Value = ActiveSheet.[B6].Value    
        .Range("F" & NR).Value = ActiveSheet.[B7].Value    
        .Range("G" & NR).Value = ActiveSheet.[B8].Value    
        Cells.UnMerge
 
        For Each Subj In Subjects   'find subjects and copy in values
            If Subj.Interior.ColorIndex = 6 Then 'yellow cell?
                Set subjFIND = ActiveSheet.Range("A:A").Find(Subj, LookIn:=xlValues, LookAt:=xlWhole)
            Else
                Set subjFIND = ActiveSheet.Range("A:A").Find(Subj, LookIn:=xlValues, LookAt:=xlPart)
            End If
            If Not subjFIND Is Nothing Then
                .Cells(NR, Subj.Column).Value = subjFIND.Offset(, 10).Value
                Set subjFIND = Nothing
            End If
        Next Subj
 
        wbData.Close False
        NR = NR + 1
        fName = Dir             'get next filename
    Loop
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Who could help me?

I added

If ActiveSheet.Range("B6").Value Is Nothing Then
            wbData.Close False
End If

but this doesnt do a thing, I do not get why...

Mathijs.