How can all characters from excel file be counted? - excel

Question

I was using the script which I found here : https://excelribbon.tips.net/T008349_Counting_All_Characters.html
It is working as expected however when there are some other objects like pictures, the script returns me the error 438"Object Doesn't Support This Property or Method".
When I deleted the pictures the script was working well again.
Is there an option to put in the script something like "ignore pictures"? Or is there any better type of script to achieve this? I am not good at all at VBA, all help will be much appreciated.

Answer 1

Here's a simplified approach that may work out a bit better. I think being explicit which Shape Types you want to count is going to be a cleaner way of going about this.
Option Explicit
Private Function GetCharacterCount() As Long
Dim wks As Worksheet
Dim rng As Range
Dim cell As Range
Dim shp As Shape
For Each wks In ThisWorkbook.Worksheets
For Each shp In wks.Shapes
'I'd only add the controls I care about here, take a look at the Shape Type options
If shp.Type = msoTextBox Then GetCharacterCount = GetCharacterCount + shp.TextFrame.Characters.Count
Next
On Error Resume Next
Set rng = Union(wks.UsedRange.SpecialCells(xlCellTypeConstants), wks.UsedRange.SpecialCells(xlCellTypeFormulas))
On Error GoTo 0
If not rng Is Nothing Then
For Each cell In rng
GetCharacterCount = GetCharacterCount + Len(cell.Value)
Next
end if
Next
End Function
Sub CountCharacters()
Debug.Print GetCharacterCount()
End Sub

Answer 2

It looks like you can add an if-check like the one here (VBA Code to exclude images png and gif when saving attachments for "PNG" and "GIF".).
You just have to change the if-check to check for the picture type you're using "JPG" or "JPEG"? Simply match the extension to the if-check by replacing "PNG" or "GIF" with your extension in CAPS.
Add the if-check right above where the error is occurring or better yet, add it above the scope of where the error is occurring.

Answer 3

I took the script from your link and modified it. Now it works.
It's far from perfect (there're some cases where it can still crash), but now it supports handling Shapes with no .TextFrame property:
Sub CountCharacters()
Dim wks As Worksheet
Dim rng As Range
Dim rCell As Range
Dim shp As Shape
Dim bPossibleError As Boolean
Dim bSkipMe As Boolean
Dim lTotal As Long
Dim lTotal2 As Long
Dim lConstants As Long
Dim lFormulas As Long
Dim lFormulaValues As Long
Dim lTxtBox As Long
Dim sMsg As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
lTotal = 0
lTotal2 = 0
lConstants = 0
lFormulas = 0
lFormulaValues = 0
lTxtBox = 0
bPossibleError = False
bSkipMe = False
sMsg = ""
For Each wks In ActiveWorkbook.Worksheets
' Count characters in text boxes
For Each shp In wks.Shapes
If TypeName(shp) <> "GroupObject" Then
On Error GoTo nextShape
lTxtBox = lTxtBox + shp.TextFrame.Characters.Count
End If
nextShape:
Next shp
On Error GoTo ErrHandler
' Count characters in cells containing constants
bPossibleError = True
Set rng = wks.UsedRange.SpecialCells(xlCellTypeConstants)
If bSkipMe Then
bSkipMe = False
Else
For Each rCell In rng
lConstants = lConstants + Len(rCell.Value)
Next rCell
End If
' Count characters in cells containing formulas
bPossibleError = True
Set rng = wks.UsedRange.SpecialCells(xlCellTypeFormulas)
If bSkipMe Then
bSkipMe = False
Else
For Each rCell In rng
lFormulaValues = lFormulaValues + Len(rCell.Value)
lFormulas = lFormulas + Len(rCell.Formula)
Next rCell
End If
Next wks
sMsg = Format(lTxtBox, "#,##0") & _
" Characters in text boxes" & vbCrLf
sMsg = sMsg & Format(lConstants, "#,##0") & _
" Characters in constants" & vbCrLf & vbCrLf
lTotal = lTxtBox + lConstants
sMsg = sMsg & Format(lTotal, "#,##0") & _
" Total characters (as constants)" & vbCrLf & vbCrLf
sMsg = sMsg & Format(lFormulaValues, "#,##0") & _
" Characters in formulas (as values)" & vbCrLf
sMsg = sMsg & Format(lFormulas, "#,##0") & _
" Characters in formulas (as formulas)" & vbCrLf & vbCrLf
lTotal2 = lTotal + lFormulas
lTotal = lTotal + lFormulaValues
sMsg = sMsg & Format(lTotal, "#,##0") & _
" Total characters (with formulas as values)" & vbCrLf
sMsg = sMsg & Format(lTotal2, "#,##0") & _
" Total characters (with formulas as formulas)"
MsgBox Prompt:=sMsg, Title:="Character count"
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
If bPossibleError And Err.Number = 1004 Then
bPossibleError = False
bSkipMe = True
Resume Next
Else
MsgBox Err.Number & ": " & Err.Description
Resume ExitHandler
End If
End Sub

Answer 4

You could try:
Option Explicit
Sub test()
Dim NoOfChar As Long
Dim rng As Range, cell As Range
NoOfChar = 0
For Each cell In ThisWorkbook.Worksheets("Sheet1").UsedRange '<- Loop all cell in sheet1 used range
NoOfChar = NoOfChar + Len(cell.Value) '<- Add cell len to NoOfChar
Next cell
Debug.Print NoOfChar
End Sub