Thread: Scanning files within a folder

Hi,

I currently have an excell workbook with several worksheets that have timed & dated info on them. Then I have a round-up sheet that will pull out the info from the other sheets related dependant of the the time and date.

For confidentiality reasons i need the original worksheets to be in seperate files. Is there anyway to adapt the following code to scan the files in a folder rather than the sheets within the workbook?

Sub Button2_Click()

Dim ws As Worksheet
Dim Cell As Object
Dim Dates As Range
Dim lastCell, DateTime, Yesterday As Double
Dim Text As String
Dim R As Long
Dim Rng As Range
Dim RngEnd As Range

Range("B3:F" & Rows.Count).ClearContents

For Each ws In Worksheets

    If ws.Range("B2") = "Date" Then
    
        lastCell = ws.Cells(Rows.Count, "B").End(xlUp).Row
        Set Dates = ws.Range("B3:B" & lastCell)
              
        If Range("J2") = "12 Hours" Then
            
            Yesterday = Range("D1") - 0.5
            
        ElseIf Range("J2") = "24 Hours" Then
            
            Yesterday = Range("D1") - 1
            
        ElseIf Range("J2") = "2 Days" Then
            
            Yesterday = Range("D1") - 2
            
        ElseIf Range("J2") = "1 Week" Then
        
            Yesterday = Range("D1") - 7
        
        End If

              
        For Each Cell In Dates
        
        DateTime = Cell + Cell.Offset(, 1)
        
        If DateTime >= Yesterday Then
        
            If Cell.Offset(, 2).Value > 0 Then
                
                If ws.Range("E1") = "Non-Residents" Or ws.Range("E1") = "Facilities" Then
                
                    Text = Cell.Offset(, 2).Value
                    
                Else
                
                    Text = ws.Range("E1") & ", " & Cell.Offset(, 2).Value
                    
                End If
            
            Else
            
                Text = ws.Range("E1")
                
            End If
        
            Range("B" & Rows.Count).End(xlUp).Offset(1).Value = DateTime
            Range("C" & Rows.Count).End(xlUp).Offset(1).Value = Text
            Range("D" & Rows.Count).End(xlUp).Offset(1).Value = Cell.Offset(, 3).Value
            
            If Cell.Offset(, 4).Value = "" Then
            
                Range("E" & Rows.Count).End(xlUp).Offset(1).Value = "None"
            Else
            
                Range("E" & Rows.Count).End(xlUp).Offset(1).Value = Cell.Offset(, 4).Value
                
            End If
            
            Range("F" & Rows.Count).End(xlUp).Offset(1).Value = Cell.Offset(, 5).Value
            
        End If
                       
        Next Cell
        
    End If
                                           
Next ws

lastCell = Cells(Rows.Count, "B").End(xlUp).Row
Set Dates = Range("B3:F" & lastCell)

Dates.Sort Key1:=Range("B3")
   
Set Rng = Range("D3")

Set RngEnd = Cells(Rows.Count, Rng.Column).End(xlUp)

If RngEnd.Row >= Rng.Row Then
    
    Set Rng = Range(Rng, RngEnd)

    For R = Rng.Rows.Count To 2 Step -1
        If Rng.Item(R) = Rng.Item(R - 1) Then Rng.Item(R).EntireRow.Delete
    Next R
    
End If
     
Beep
End Sub

Thanks
Mark

I appears that the code you have now is written in the code window of a worksheet. If so, then the first thing I suggest is to put most of your code in a separate module, and simply call the subroutine from the button_click even handler.

Once you have the code working as before with the bulk of it being in a separate code module, then here is a suggestion for the code.

Dim strFolder As String
Dim strFile As String
Dim wb As Workbook

    strFile = ThisWorkbook.Worksheets("Roundup").Range("A1")  'assumes you put the folder location in this cell
    strFile = Dir(strFolder, vbDirectory)
    If strFile = "" Then
        MsgBox "Nothing in the folder", vbCritical, "Bogus!"
        End
    End If

    strFile = Dir(strFolder & "\*xls*")
    
    Do While strFile <> ""

        strFile = strFolder & "\" & strFile
        Set wb = Workbooks.Open(Filename:=strFile, ReadOnly:=True)
    '**********************************
    '   put your code here
    '*********************************
    
        wb.Close SaveChanges:=False
        strFile = Dir()
        
    Loop

Oops...

One more thing I almost forgot, but very important ... in the For ... Each loop for worksheets within a workbook, you will need to specific which workbook.

For Each ws In wb.Worksheets