Counting Rows and Columns in Folder

esimmions

New Member
Joined
Aug 11, 2014
Messages
1
Hello Folks,

I want to create a macro that will allow me to select a folder and then open each .xlsx file and count the number of rows and columns in each spreadsheet. (for now i want to assume there is no tabs) Then i want to display the name of the .xlsx file in column A and display their respected number of rows in column B and number of columns in C.

Right now i can list the names of all excel files in the folder, but my main problem is that the row/column count keeps getting messed up. I don't have any macro coding experience and i have just researching online and picking up code that i think will work. Any help or suggestions i would greatly appreciate!


Sub CountRows()
Dim wb As Workbook, wbXLS As Workbook
Dim LastRow As Long
Dim sPath As String, sFilename As String
Dim LastColumn As Long
Dim sFName As String
Dim intFNumber As Integer
Dim lCounter As Long
Dim lLastRow As Long
Dim sText As String
Dim TxtRng As Range
Dim xRow As Long
Dim bRow As Long
Dim cRow As Long
Dim xDirect$, xFname$, InitialFoldr$



InitialFoldr$ = "C:\Users/abc/123/" '<<< Startup folder to begin searching from

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir

Loop

sFName = ThisWorkbook.Path & "\Excel Data (Write).txt"


DisplayAlerts = False
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
ws.Unprotect




Set TxtRng = ws.Range("B1:B5")




Application.ScreenUpdating = False
sPath = "" 'Path of XLS Files
sFilename = Dir(sPath & "*.xls")
On Error Resume Next
Do While Len(sFilename) > 0
If sFilename <> ThisWorkbook Then
Set wbXLS = Workbooks.Open(sPath & sFilename)
'open file
With ActiveSheet.UsedRange
LastRow = .Rows(.Rows.Count).Row
End With
ws.Range("B" & Rows.Count).End(xlUp).Offset(1) = LastRow


With ActiveSheet.UsedRange
LastColumn = .Columns(.Columns.Count).Column
End With
ws.Range("C" & Rows.Count).End(xlUp).Offset(1) = LastColumn

rg = sFilename
rg.Offset(0, 1) = NbRows
wbXLS.Close False 'close file
End If
sFilename = Dir

Loop
Application.ScreenUpdating = True
DisplayAlerts = True
TxtRng.Value = LastColumn


End If
End With
End Sub
 

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

ParamRay

Well-known Member
Joined
Aug 6, 2014
Messages
1,195
Try using the following code instead of yours.

Before running the macro, you'll first need to change this line to your folder:
Code:
FileFold = "C:\Users\jsmith\Desktop"


Code:
Sub Test()
    
    Dim FileFold As String
    Dim FileSpec As String
    Dim FileName As String
    Dim FileInfo() As Variant
    Dim ShtCnt As Long
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim Summary As Worksheet
    
    FileFold = "C:\Users\jsmith\Desktop" 'set the folder
    FileSpec = FileFold & Application.PathSeparator & "*.xl*"
    FileName = Dir(FileSpec)
    
    If FileName = vbNullString Then
        MsgBox "No files were found that match " & FileSpec
        Exit Sub
    End If
        
    ReDim FileInfo(5, 1)
    FileInfo(1, 1) = "Workbook Path"
    FileInfo(2, 1) = "Workbook Name"
    FileInfo(3, 1) = "Worksheet Name"
    FileInfo(4, 1) = "Worksheet UsedRows"
    FileInfo(5, 1) = "Worksheet UsedColumns"
    
    ShtCnt = 1
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Do While FileName <> vbNullString
        Set wb = Workbooks.Open(FileFold & Application.PathSeparator & FileName, False)
        For Each ws In wb.Worksheets
            ShtCnt = ShtCnt + 1
            ReDim Preserve FileInfo(5, ShtCnt)
            FileInfo(1, ShtCnt) = wb.Path
            FileInfo(2, ShtCnt) = wb.Name
            FileInfo(3, ShtCnt) = ws.Name
            FileInfo(4, ShtCnt) = ws.UsedRange.Rows.Count
            FileInfo(5, ShtCnt) = ws.UsedRange.Columns.Count
        Next ws
        wb.Close SaveChanges:=False
        FileName = Dir
    Loop
    
    Set Summary = Workbooks.Add.Worksheets(1)
    Summary.Range("A1:E" & ShtCnt).Value = Application.Transpose(FileInfo)
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    MsgBox "Done"

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,632
Messages
5,597,287
Members
414,134
Latest member
Tiyas44

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
Top