Find text in columnThen count rows with data

[Diddy]

Hi everyone,

This is a big ask!

I need a way to count the number of rows of data in each of the workbooks in
a folder. Some workbooks have 1 tabs, some have up to 6. The number of rows
before the header row varies as different people have slightly different ways
of setting up their worksheets.

What I would like to do is find "Surname" in Column C, then count number of
rows with data after that.
Then if possible return the number of rows to a new workbook identified by
filename and sheet name if possible.

If anyone can help that would be more than fantastic!

 

[JLGWhiz]

This is untested so you might have to do some clean up.

Assuming the Workbook with the code is in the same folder.

Sub countRows()

Set NewBk = Workbooks.Add
myFolder = ThisWorkbook.Path
For Each wb In myFolder.Workbooks
For Each sh in wb.Worksheets
rc = 0
lr = sh.Cells(Rows.Count, 3).End(xlUp).Row
Set c = sh.Find("Surname", LookIn:=xlValues
If Not c Is Nothing Then
Set rng = Range("C" & c.Row +1& ":C" & lr)
rc = sh.rng.Rows.Count
End If
With NewBk.Sheets(1)
lr2 = NewBk.Sheets(1) _
.Cells(Rows.Count, 1).End(xlUP).Row
If .Range "A2" = "" Then
.Range("A2") = wb.Name
.Range("B2") = sh.Name
.Range("C3") = rc
Else
.Range("A" & lr2) = wb.Name
.Range("B" & lr2) = sh.Name
.Range("C" & lr2) = rc
End If
End With
Next
Next
End Sub

 

[JLGWhiz]

P.S. You will need to open all of the workbooks.

 

[Diddy]

Hi JLGWhiz,

Thanks for your reply,

I've added a) to the end of Set c = sh.Find("Surname", LookIn:=xlValues)
but that's as far as I can go :-(

I've got red lines for
Set rng = Range("C" & c.Row +1& ":C" & lr)
and
If .Range "A2" = "" Then

I've tried looking in help but only a relative newbie.

Could I be a total pain and ask for soem help on declaring the variables
please

Many many thanks
Diddy

 

[JLGWhiz]

Let's start over. First, open the workbooks you want to check. Then try
this revised code. It seems to run OK, but I only did limited test on it.

Sub countRows()
Dim rc As Long, lr As Long, lr2 As Long
Dim c As Range, NewBk As Workbook, rng As Range
Dim myFolder As String, sh As Worksheet, wb As Workbook
Set NewBk = Workbooks.Add
For Each wb In Application.Workbooks
For Each sh In wb.Worksheets
rc = 0
lr = sh.Cells(Rows.Count, 3).End(xlUp).Row
Set c = sh.Cells.Find("Surname", LookIn:=xlValues)
If Not c Is Nothing Then
Set rng = Range("C" & c.Row + 1 & ":C" & lr)
rc = rng.Rows.Count
End If
With NewBk.Sheets(1)
lr2 = NewBk.Sheets(1) _
.Cells(Rows.Count, 1).End(xlUp).Row
If .Range("A2") = "" Then
.Range("A2") = wb.Name
.Range("B2") = sh.Name
.Range("C3") = rc
Else
.Range("A" & lr2) = wb.Name
.Range("B" & lr2) = sh.Name
.Range("C" & lr2) = rc
End If
End With
Next
Next
End Sub

 

[Diddy]

Hi,

Thank you again.

The new book opens and Book Sheet and Number for each workbook flashes up on
row 2 and ends with the new book no.

so it's going into each workbook counting rows but not moving to the next
row before overwriting with next workbooks info.

Cheers
Diddy

 

[JLGWhiz]

Hopefully, all the typos are gone and the omissions have been added in. I
did a full test on this one and it listed all of the data correctly. I did
not include the naming of the new workbook nor saving it since you gave no
indication that it would always be the same. You can handle that manually.
One thing to remember is that it will create a new workbook each time it is
run, NOT the same workbook over and over..

Sub countRows()
Dim rc As Long, lr As Long, lr2 As Long
Dim c As Range, NewBk As Workbook, rng As Range
Dim myFolder As String, sh As Worksheet, wb As Workbook
Set NewBk = Workbooks.Add
For Each wb In Application.Workbooks
If wb.Name <> NewBk.Name Then
For Each sh In wb.Worksheets
rc = 0
lr = sh.Cells(Rows.Count, 3).End(xlUp).Row
Set c = sh.Cells.Find("Surname", LookIn:=xlValues)
If Not c Is Nothing Then
Set rng = Range("C" & c.Row + 1 & ":C" & lr)
rc = rng.Rows.Count
End If
With NewBk.Sheets(1)
lr2 = NewBk.Sheets(1) _
.Cells(Rows.Count, 1).End(xlUp).Row
If .Range("A2") = "" Then
.Range("A2") = wb.Name
.Range("B2") = sh.Name
.Range("C2") = rc
Else
.Range("A" & lr2 + 1) = wb.Name
.Range("B" & lr2 + 1) = sh.Name
.Range("C" & lr2 + 1) = rc
End If
End With
Next
End If
Next

End Sub

 

[Diddy]

THANK YOU SO MUCH!!!!!!

What can I say - I'm just so so chuffed, it does just what I need.

Thanks again
Diddy