Count IF >0 but from many workbooks in a folder

C

cbarryb

New Member
Joined
Jun 1, 2012
Messages
34
Office Version
  1. 365
Platform
  1. Windows
  2. Web
Hi All, I have many files in folders (Year then Month) and I've been given a task to report on how many lines each individual file in has, if the amount is greater than 0.

Is there a way with VBA coding or even a bunch of formulas, to be able to get the file paths and names and then be able to count the amount of lines in column D of each Sheet 1, greater than 0.

Or would it be easier to pull all the Sheets in to a workbook, run a power query to put them into a single table and then countif dates match?

Any help would be much appreciated, thank you.
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Try this code
VBA Code: 
Sub LoopThroughFiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim n As Long
Dim ws As Worksheet, wsData As Worksheet
Dim wb As Workbook, wbData As Workbook

Application.ScreenUpdating = False
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\Foldername")                   ' Set Folder name & path here

' Define current workbook as wb and Sheet1 of current workbook as ws
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")

n = 0
On Error Resume Next
For Each oFile In oFolder.Files
    ' Open each workbook in the folder and define as wbData
    Set wbData = Workbooks.Open(Filename:=oFile, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    ' Define Sheet1 of opened workbook as wsData
    Set wsData = wbData.Sheets("Sheet1")

    ' Write filename and last row for each file
    ws.Range("A" & i + 1) = oFile.Name
    If Not Err.Number = 0 Then
        ws.Range("B" & i + 1) = "No Sheet1 found"
        Err.Clear
    Else
        ws.Range("B" & i + 1) = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    End If
    i = i + 1
    'Close wbData without saving
    wbData.Close False
Next oFile
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
 
Upvote 0
You have to edit the folder path every time you want to change folder or even folder name. So it is not that flexible. I made some modification to the code above. The new code will allow you to select the folder on the run.
VBA Code: 
Sub LoopThroughFiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim n As Long, SelectFolder As Long
Dim ws As Worksheet, wsData As Worksheet
Dim wb As Workbook, wbData As Workbook

Application.ScreenUpdating = False

SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(strPath)

' Define current workbook as wb and Sheet1 of current workbook as ws
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")

n = 0
On Error Resume Next
For Each oFile In oFolder.Files
    ' Open each workbook in the folder and define as wbData
    Set wbData = Workbooks.Open(Filename:=oFile, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    ' Define Sheet1 of opened workbook as wsData
    Set wsData = wbData.Sheets("Sheet1")

    ' Write filename and last row for each file
    ws.Range("A" & i + 1) = oFile.Name
    If Not Err.Number = 0 Then
        ws.Range("B" & i + 1) = "No Sheet1 found"
        Err.Clear
    Else
        ws.Range("B" & i + 1) = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    End If
    i = i + 1
    'Close wbData without saving
    wbData.Close False
Next oFile
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
 
Upvote 0
Zot said:
You have to edit the folder path every time you want to change folder or even folder name. So it is not that flexible. I made some modification to the code above. The new code will allow you to select the folder on the run.
VBA Code: 
Sub LoopThroughFiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim n As Long, SelectFolder As Long
Dim ws As Worksheet, wsData As Worksheet
Dim wb As Workbook, wbData As Workbook

Application.ScreenUpdating = False

SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(strPath)

' Define current workbook as wb and Sheet1 of current workbook as ws
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")

n = 0
On Error Resume Next
For Each oFile In oFolder.Files
    ' Open each workbook in the folder and define as wbData
    Set wbData = Workbooks.Open(Filename:=oFile, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    ' Define Sheet1 of opened workbook as wsData
    Set wsData = wbData.Sheets("Sheet1")

    ' Write filename and last row for each file
    ws.Range("A" & i + 1) = oFile.Name
    If Not Err.Number = 0 Then
        ws.Range("B" & i + 1) = "No Sheet1 found"
        Err.Clear
    Else
        ws.Range("B" & i + 1) = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    End If
    i = i + 1
    'Close wbData without saving
    wbData.Close False
Next oFile
On Error GoTo 0
Application.ScreenUpdating = True

End Sub
Click to expand...
This code is superb thank you and it pulls off the file name, but in colum B, it only shows No Sheet1 Found.
 

Attachments

  • mrexcel12.png
    mrexcel12.png
    36 KB · Views: 4
Upvote 0
The sheet name the code is looking for is Sheet1. If no Sheet1 name found, then you get this message. If you want to look inside 1st sheet or sheet index 1, then you just change the line:
Rich (BB code): 
For Each oFile In oFolder.Files
    ' Open each workbook in the folder and define as wbData
    Set wbData = Workbooks.Open(Filename:=oFile, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    ' Define Sheet1 of opened workbook as wsData
    Set wsData = wbData.Sheets("Sheet1") wbData.Sheets(1)

Found another mistake. I got carried away. You said to count column D but I count column A. This line is counting the last row

ws.Range("B" & i + 1) = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row

Please change A to D :)

I hope this solves the problem
 
Upvote 0
Oppss I forgot that I need to remove the code looking for Sheet1 name. Otherwise you will still see the message the Sheet1 is not found. Here's the whole code modified
VBA Code: 
Sub LoopThroughFiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim n As Long, SelectFolder As Long
Dim ws As Worksheet, wsData As Worksheet
Dim wb As Workbook, wbData As Workbook

Application.ScreenUpdating = False

SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(strPath)

' Define current workbook as wb and Sheet1 of current workbook as ws
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")

n = 0
For Each oFile In oFolder.Files
    ' Open each workbook in the folder and define as wbData
    Set wbData = Workbooks.Open(Filename:=oFile, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    ' Define Sheet1 of opened workbook as wsData
    Set wsData = wbData.Sheets(1)

    ' Write filename and last row for each file
    ws.Range("A" & i + 1) = oFile.Name
    ws.Range("B" & i + 1) = wsData.Cells(wsData.Rows.Count, "D").End(xlUp).Row
    i = i + 1
    'Close wbData without saving
    wbData.Close False
Next oFile

Application.ScreenUpdating = True

End Sub
 
Upvote 0
Solution
Zot said:
Oppss I forgot that I need to remove the code looking for Sheet1 name. Otherwise you will still see the message the Sheet1 is not found. Here's the whole code modified
VBA Code: 
Sub LoopThroughFiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim n As Long, SelectFolder As Long
Dim ws As Worksheet, wsData As Worksheet
Dim wb As Workbook, wbData As Workbook

Application.ScreenUpdating = False

SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(strPath)

' Define current workbook as wb and Sheet1 of current workbook as ws
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")

n = 0
For Each oFile In oFolder.Files
    ' Open each workbook in the folder and define as wbData
    Set wbData = Workbooks.Open(Filename:=oFile, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
    ' Define Sheet1 of opened workbook as wsData
    Set wsData = wbData.Sheets(1)

    ' Write filename and last row for each file
    ws.Range("A" & i + 1) = oFile.Name
    ws.Range("B" & i + 1) = wsData.Cells(wsData.Rows.Count, "D").End(xlUp).Row
    i = i + 1
    'Close wbData without saving
    wbData.Close False
Next oFile

Application.ScreenUpdating = True

End Sub
Click to expand...
Perfect, thank you very much
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
VBA to import multilpe xml files
Replies
1
Views
94
PippaThePointer
P
L
  • Question
Importing Outlook Data
Replies
0
Views
398
Legacy 512328
L
N
  • Question
Stock count
Replies
1
Views
66
akmatz
A
G
  • Question
Open workbooks in folder and run Macro in each book
Replies
7
Views
404
glynn1969
G
J
  • Question
Macro to load 10 files from different folder into different sheets in Master File
Replies
2
Views
155
joxyin
J

Forum statistics

Threads
1,215,500
Messages
6,125,166
Members
449,210
Latest member
grifaz

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top