workbook Statistics (Cell counting)

[dircur]

I need to get stats on ~ 600 work books. I am trying to determine from a list of workbooks; how many cells are occupied, how many have formula and how many are constants. I cant seem to figure out an efficient way of getting that info. I am OK with VBA and have built some reasonable routines. is there any way to nest countif(isformula(all worksheets in the filepath referenced in the cell to the left)) and similarly countA(all cells in the same file)

Thanks

 

[Richard Schollar]

Hi

Your best bet would be to open the workbooks and loop thru the worksheets in each one and apply the SpecialCells method to each worksheet's usedarea. This isn't infallible, but unless you really have truly humongous files with thousands of non-contiguous formula/constant cells it should work.

 

[dircur]

I'll give it a go. It will take me some time to build so I can't be as instantly gratifying as your reply.
Thanks regardless and I will post back my success or failure.

 

[dircur]

Thanks Richard you put me on a very direct path and I was amazed at how simple it turned out to be.
I'm sure this has is buggy as I am not even close to a programmer. None the less this is what I came up with and it does what I need it to.

The weird name is because this is more of a mockup I used to figure out how to get the data I want. I'm sure there are better ways to do it as illustrated by the file system call for the file size and then opening the workbook anyway to get other info.
My pride is in that I saved myself some time not in the quality of my programming. Maybe someone else will post a link to some better code, cause I can't be the first or last that needs to do this sort of thing.

_____________________

Sub HandsTogether()
'**GET FILE
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
ActiveSheet.Range("B5").Value = vrtSelectedItem
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
On Error GoTo 0
'**GET DETAILS
Application.ScreenUpdating = False
Dim stFileName
strComputer = "."
stFileName = Range("B5").Value
stPassingFileName = Replace(stFileName, "\", "\\")
'MsgBox stFileName
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("SELECT * FROM CIM_Datafile WHERE Name = '" & stPassingFileName & "'")
For Each objFile In colFiles
ActiveSheet.Range("B6").Value = objFile.FileSize / 1024
Next

'***1+1
Dim SheetFormulasRange As Range
Dim SheetConstantRange As Range
File1 = ActiveWorkbook.Name
Workbooks.Open FileName:=stFileName
File2 = ActiveWorkbook.Name
Formcount = 0
ConstCount = 0
FSheetCount = 0
CSheetCount = 0
OccupiedSheets = 0
MaxCalSht = 0.0001
MaxCalBok = 0
MaxConSht = 0
MaxConBok = 0
For Each Sheet In Worksheets
On Error Resume Next
Set SheetFormulasRange = Sheet.Cells.SpecialCells(xlCellTypeFormulas)
FSheetCount = SheetFormulasRange.Count
If Err.Number <> 0 Then
FSheetCount = 0
Err.Clear
Else
Formcount = Formcount + FSheetCount
MaxCalSht = Application.Max(SheetFormulasRange)
If MaxCalSht > MaxCalBok Then
MaxCalBok = MaxCalSht
End If
MaxCalSht = 0
End If
Set SheetConstantRange = Sheet.Cells.SpecialCells(xlCellTypeConstants)
CSheetCount = SheetConstantRange.Count
If Err.Number <> 0 Then
CSheetCount = 0
Err.Clear
Else
ConstCount = ConstCount + CSheetCount
MaxConSht = Application.Max(SheetConstantRange)
If MaxConSht > MaxConBok Then
MaxConBok = MaxConSht
End If
End If
If CSheetCount + FSheetCount > 0 Then
OccupiedSheets = OccupiedSheets + 1
End If
FSheetCount = 0
CSheetCount = 0
On Error GoTo 0
Next
'Application.DisplayAlerts = False
'ActiveWorkbook.Close
'Application.DisplayAlerts = True
Workbooks(File1).Activate
ActiveCell.Offset(2, 0).Value = Formcount
ActiveCell.Offset(3, 0).Value = ConstCount
ActiveCell.Offset(4, 0).Value = OccupiedSheets
ActiveCell.Offset(5, 0).Value = MaxCalBok
ActiveCell.Offset(6, 0).Value = MaxConBok
Application.ScreenUpdating = True
End Sub