How to count number of rows and to move files automatically with VBA macros?

Question

My goal is to write a VBA macros that will allow:

1. to choose a folder with files to open
2. then to count number of rows in each file (each file contain only 1 sheet).
3. to move to another folder all the files that contain more than 1 row

I'm very new in VBA, so what i found is how to count number of rows from active worksheet, but i still can't manage automatically files opening and moving to another folder:

Sub RowCount()
    Dim iAreaCount As Integer
    Dim i As Integer
    Worksheets("Sheet1").Activate
    iAreaCount = Selection.Areas.Count
    If iAreaCount <= 1 Then
        MsgBox "The selection contains " & Selection.Rows.Count & " rows."
    Else
        For i = 1 To iAreaCount
            MsgBox "Area " & i & " of the selection contains " & _
            Selection.Areas(i).Rows.Count & " rows."
        Next i
    End If
End Sub

Could someone help with this, please?

Answer 1

This is actually easy. Really easy. :)

First, code to choose a folder to look into for Excel files. Used Google and searched for excel vba select folder dialog. First result yields this code:

Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

We'll get to using it for later. Next, we need a loop to count how many rows there are in each file/sheet. However, we can't count them without these files open. So, let's look for a code that opens workbooks in a loop. Googling excel vba open excel files in folder, we get the second result. First result is a deprecated method in Excel 2007 and up. I will be assuming you're running 2007 and up. Here's the code, applying the proper correction detailed by Siddharth Rout.

Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "Blah blah blah"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub

Now, some semi-advanced best practices. Rather than opening each workbook/worksheet/file and counting the rows in each of the opened files (which is highly counter-intuitive), let's modify the above code to count the rows in each file as well, then move them to another folder if they have more than one (1) used row. We'll also change the above code to take into consideration as well the first function to get the folder we want to apply the second code to.

Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = GetFolder("C:\users\yourname\Desktop" 'Modify as needed.
MyFile = Dir(MyFolder & "\*.xlsx") 'Modify as needed.
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Loop
End Sub

See what happened there? We called the GetFolder function and assigned it to MyFolder. We then concatenate MyFolder and a wildcarded string, then pass it to Dir so we can loop over the files. What's the remaining two things? Right, count the used rows AND moving the files. For the used rows, I'll hack a simple function to check the workbook's only sheet to see if the row is 2 or greater.

Function CountUsedRows(Wbk As Workbook) As Long
    Dim WS As Worksheet
    Set WS = Wbk.Sheets(1)
    CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 'Modify as necessary.
End Function

Now that's simple enough. Next, let's write a simple code to move the files. For personal purposes, I'll write a code to copy instead. It'll be up to you to modify it for moving, as that's a rather sensitive operation and if it messes up... well. Hmm. But something here tells me that there's a much better option. Copying can cause all manners of error from permission denial to erroneous copying. Since we've got the file open, why not just save them instead to the new folder?

Now, let's tie them all together neatly.

Sub OpenFiles()
    Dim MyFolder As String
    Dim MyFile As String
    Dim TargetWB As Workbook
    MyFolder = GetFolder("C:\Users\yourname\Desktop") 'Modify as needed.
    MyFile = Dir(MyFolder & "\*.xlsx") 'Modify as needed.
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Do While MyFile <> ""
        Set TargetWB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
        With TargetWB
            If CountUsedRows(TargetWB) > 1 Then
                .SaveAs "C:\Users\yourname\Desktop\Blah\CopyOf" & MyFile 'Modify as needed.
            End If
            .Close
        End With
    MyFile = Dir
    Loop
    Shell "explorer.exe C:\Users\yourname\Desktop\Blah", vbMaximizedFocus 'Open the folder.
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Function GetFolder(strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
    NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Function CountUsedRows(Wbk As Workbook) As Long
    Dim WS As Worksheet
    Set WS = Wbk.Sheets(1)
    CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 'Modify as necessary.
End Function

Tried and tested. Let us know if this works for you.

Answer 2

Nice answer from Manhattan: that's exactly how I use Excel's built-in functionality to select a folder and fetch a set of file names.

However, there's an interesting side-question in there:

Are those single-sheet Excel files workbooks, of just .csv text files?

If they have a .csv extension, you don't need to open them in Excel to count the rows!

Here's the code to do it:

Fast VBA for Counting Rows in a CSV file

 
Public Function FileRowCount(FilePath As String, Optional RowDelimiter As String = vbCr) As Long
' Returns the row count of a text file, including the header row
' Returns - 1 on error

' Unicode-compliant, works on UTF-8, UTF-16, ASCII, with or without a Byte order Marker.
' Reads a typical 30Mb file over the network in 200-300ms. Hint: always copy to a local folder.

' If you're scanning files for use with a SQL driver, use basSQL.TableRowCount: it's 20x slower,
' but it returns a proper test of the file's usability as a SQL 'table'

' Nigel Heffernan    Excellerando.Blogspot.com  2015

' Unit test:
' s=Timer : for i = 0 to 99 : n=FileRowCount("C:\Temp\MyFile.csv") : Next i : Print Format(n,"#,##0") & " rows in " & FORMAT((Timer-s)/i,"0.000") & " sec"

' Network performance on a good day: reads ~ 150 MB/second, plus an overhead of 70 ms for each file
' Local-drive performance:                 ~ 4.5 GB/second, plus an overhead of  4 ms for each file

On Error Resume Next

Dim hndFile     As Long
Dim lngRowCount As Long
Dim lngOffset   As Long
Dim lngFileLen  As Long

Const CHUNK_SIZE As Long = 8192

Dim strChunk As String * CHUNK_SIZE

If Len(Dir(FilePath, vbNormal)) < 1 Then
    FileRowCount = -1
    Exit Function
End If

' trap the error of a folder path without a filename:
If FileName(FilePath) = "" Then
    FileRowCount = -1
    Exit Function
End If

 
    hndFile = FreeFile
    Open FilePath For Binary Access Read Shared As #hndFile


    lngFileLen = LOF(hndFile)


    lngOffset = 1
    Do Until EOF(hndFile)
        Get #hndFile, , strChunk
        FileRowCount = FileRowCount + UBound(Split(strChunk, RowDelimiter))
    Loop


    Close #hndFile
    Erase arrBytes

End Function



Public Function FileName(Path As String) As String
' Strip the folder and path from a file's path string, leaving only the file name

' This does not check for the existence or accessibility of the file:
' all we're doing here is string-handling

' Nigel Heffernan    Excellerando.Blogspot.com  2011

Dim strPath   As String
Dim arrPath() As String

Const BACKSLASH As String * 1 = "\"

strPath = Trim(Path)

If strPath = "" Then Exit Function
If Right$(strPath, 1) = BACKSLASH Then Exit Function

arrPath = Split(strPath, BACKSLASH)

If UBound(arrPath) = 0 Then          ' does not contain "\"
    FileName = Path
Else
    FileName = arrPath(UBound(arrPath))
End If

Erase arrPath

End Function

Note the use of the Split function to count the row separators: VBA's string-handling is generally slow, especially when you concatenate strings, but there are a couple of places where VBA can perform a string manipulation without internal allocation and deallocation; if you know where they are, you'll find that parts of your code run as fast as a 'C' developer's best work.

Warning: Horrible Hack Strictly speaking, I should declare Dim arrBytes(CHUNK_SIZE) As Byte and use this Byte array instead of strChunk to receive the Get from a file opened for binary read.

There are two reasons for not doing it the 'right' way:

1. The last Get, which will set end-of-file TRUE, will extract less data from the file than the full 'chunk'. What happens next is that these last few bytes of the file are written into the array without clearing out the data from the previous 'Get'. So you have to do additional plumbing, counting bytes off against LOF(#hwndFile) to detect the 'Last Get' and branching into a statement that clears the buffer, or allocates a smaller byte array and uses that instead;
2. The code will only cope with UTF-8 2-byte encoded character sets, or with single-byte encoded ASCII 'Latin' text if you do a bit of byte-array substitution around your row delimiters.

The VBA String type is a byte array with a wrapper that allows your code (or rather, the compiler) to handle all that complexity in the background.

However, it's much faster to go back into the primordial C, using old-school Get statements, than using later libraries like Scripting.FileSystemObject. Also, you have some ability to examine the incoming data at the byte level, to debug issues where you're getting '???????' characters instead of the text you were expecting.

Anyway: this is late to the game, as StackOverflow answers go, and it's an answer to the less-interesting part of your question. But it's going to be interesting to people who need a quick rowcount in their data files, and your question comes at the top of the list when they search for that.