CODEWITHSUNDEEP
vbaexcel
Smits
Smits

Reputation: 55

Excel looping through directory continue search without matches

When I'm looping through directory to find matches between files in a specific folder and cell/row one of my master file, and copy these matched rows to my master file, I get an error 91 notification if there are no matches between the master file and a file in the folder I'm looping through.

If a specific file doesn't have a match I want my macro to automatically look at the next file and so on without giving me this error obviously. Any suggestions how to solve this?

Option Explicit

Sub CopyToMasterFile()

    Dim MasterWB As Workbook
    Dim MasterSht As Worksheet
    Dim MasterWBShtLstRw As Long
    Dim FolderPath As String
    Dim TempFile
    Dim CurrentWB As Workbook
    Dim CurrentWBSht As Worksheet
    Dim CurrentShtLstRw As Long
    Dim CurrentShtRowRef As Long
    Dim CopyRange As Range
    Dim ProjectNumber As String
    Dim wbname As String
    Dim sheetname As String

    wbname = ActiveWorkbook.Name
    sheetname = ActiveSheet.Name

    FolderPath = "C:\data\"
    TempFile = Dir(FolderPath)

    Dim WkBk As Workbook
    Dim WkBkIsOpen As Boolean

    For Each WkBk In Workbooks
        If WkBk.Name = wbname Then WkBkIsOpen = True
    Next WkBk

    If WkBkIsOpen Then
        Set MasterWB = Workbooks(wbname)
        Set MasterSht = MasterWB.Sheets(sheetname)
    Else
        Set MasterWB = Workbooks.Open(FolderPath & wbname)
        Set MasterSht = MasterWB.Sheets(sheetname)
    End If

    ProjectNumber = MasterSht.Cells(1, 1).Value



    Do While Len(TempFile) > 0


        If Not TempFile = wbname And InStr(1, TempFile, "xlsx", vbTextCompare) Then

            Set CopyRange = Nothing

            With MasterSht
                MasterWBShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
            End With

            Set CurrentWB = Workbooks.Open(FolderPath & TempFile)
            Set CurrentWBSht = CurrentWB.Sheets(1)

            With CurrentWBSht
                CurrentShtLstRw = .Cells(.Rows.Count, "AD").End(xlUp).Row
            End With

            For CurrentShtRowRef = 1 To CurrentShtLstRw

             If CurrentWBSht.Cells(CurrentShtRowRef, "AD").Value = ProjectNumber Then


            If CopyRange Is Nothing Then
              set CopyRange = CurrentWBSht.Range("AE" & CurrentShtRowRef & _
                                                ":AQ" & CurrentShtRowRef)
                Else
                 Set CopyRange = Union(CopyRange, _
                                        CurrentWBSht.Range("AE" & CurrentShtRowRef & _
                                                            ":AQ" & CurrentShtRowRef))
               End If  
             End If 

            Next CurrentShtRowRef

            CopyRange.Select


            CopyRange.Copy
            MasterSht.Cells(MasterWBShtLstRw + 1, 1).PasteSpecial xlPasteValues

            Application.DisplayAlerts = False
            CurrentWB.Close savechanges:=False
            Application.DisplayAlerts = True

        End If     

        TempFile = Dir

    Loop

ActiveSheet.Range("A1:M200").RemoveDuplicates Columns:=Array(1, 2, 4, 8, 9, 10, 11, 12), Header:=xlYes

End Sub

Upvotes: 0

Views: 63

Answers (2)

Smits
Smits

Reputation: 55

Changing the following part of my macro solved this problem:

Next CurrentShtRowRef
             If Not CopyRange Is Nothing Then
              CopyRange.Select

              CopyRange.Copy
              MasterSht.Cells(MasterWBShtLstRw + 1, 1).PasteSpecial xlPasteValues
             End If

Upvotes: 0

Diveye
Diveye

Reputation: 271

Use this condition after your if matching condition (it will be executed after the matching condition, but keep it in the loop)

if index = lastindex then 'if you have reached the end of the current file
'proceed to next file

Where index is the index of the row/columns you are scanning within the current file and lastindex is the lastindex of the current file (therefore the end of the current file).

This will however require you to know the lastindex of the files you scan through. But you can easily accomplish this with a do while loop:

index= 1
    Do While (Not IsEmpty(Sheets("YourSheetName").Cells(index, 1)))
        index= index+ 1

    Loop
    index= index- 1 'remove last cell corresponding to first empty cell

This above loop works for rows but you can easily use it for columns. Hope this helped!

Upvotes: 1

Related Questions