VBA – How to use COUNTA for range in closed workbook?

As a check, I am comparing the source data (the closed workbook) to the imported file in the current workbook.  I am trying to do this by counting the non-blank cells in column A in both files.  How do I target another workbook and count the non-blank cells without opening it?
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Sam JacobsDirector of Technology Development, IPMCommented:
While I don't believe that you can do a COUNTA on a closed workbook, if you have the formula in a cell in the closed workbook, you can extract it from there. Please see the attached example files.
kbay808Author Commented:
I can do a COUNTA function in my current workbook that references the other workbook, but it will only update if I open the other workbook.  I'm looking for a solution that does not require opening the other workbook, because I have 7 files that I need to do this with.  Since the files are downloaded every day, adding the COUNTA on the closed workbook is not feasible.
Sam JacobsDirector of Technology Development, IPMCommented:
Sorry ... I don't know how to do that with a closed workbook - maybe someone else would know.
Failing that, could you programmatically open & close the files?
Introduction to R

R is considered the predominant language for data scientist and statisticians. Learn how to use R for your own data science projects.

kbay808Author Commented:
Yes I can, as a backup measure.  I still hoping that we can somehow add the below line to your code.

Open in new window

I'm posting your code for others to see.
Private Function GetValue(path, file, sheet, ref)
'   Retrieves a value from a closed workbook
    Dim arg As String
'   Make sure the file exists
    If Right(path, 1) <> "\" Then path = path & "\"
    If Dir(path & file) = "" Then
        GetValue = "File Not Found"
        Exit Function
    End If
'   Create the argument
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
      Range(ref).Address(, , xlR1C1)
'   Execute an XLM macro
    GetValue = ExecuteExcel4Macro(arg)
End Function

Sub Main()
    path = ActiveWorkbook.path
    file = "countA.xlsx"
    sheet = "Sheet1"
    cell = "C2"
    Range("B1").Value = GetValue(path, file, sheet, cell)
End Sub

Open in new window

Ejgil HedegaardCommented:
COUNTA should work, just tested.
Count on Sheet1, column A in workbook C:\Test\Data.xlsx

You can use SUMPRODUCT to do the same
kbay808Author Commented:
Ejgil - I was not able to get it to work.  Do you have the target workbook closed what entering the formula into the current worksheet?
Fabrice LambertConsultingCommented:

What do you mean exactly by "closed workbook" ?
To my knowledge, this involve setting an ODBC connection to it, and retrieving data with an SQL query.

This kind of formula work, but absolute path can be a problem.
Professor JMicrosoft Excel ExpertCommented:
You can use the attached example.  I tested it and it works.  This UDF is very powerful, You can refer to the closed workbook data and the retrieved closed workbook data will be stored in the static memory.

I have embedded the code into the workbook.

All you need to update the references from D1 to G1 and see how it is used.  and the formula =SUMPRODUCT(--(IndirectEx(H2)<>0))  0 represents blank.


Function IndirectEx(ref_text As String, Optional refresh_memory As Boolean = False) As Variant
    On Error GoTo ClearObject
' Originally written by Wilson So,  Modified by ProfessorJimJam
    Dim RefName As String
    Dim SheetName As String
    Dim WBName As String
    Dim FolderName As String
    Dim vExcel As Object
    Dim vWB As Workbook
    Static dbOutput() As Variant
    Static dbKey() As String
    Static dbTotalOutput As Integer
    Dim dbIndex As Integer
    Dim UserEndRow As Long, UserEndCol As Integer
    Dim RealEndRow As Long, RealEndCol As Integer
    Dim EndRow As Long, EndCol As Integer
    Dim RangeHeight As Long, RangeWidth As Integer
    GetNames ref_text, RefName, SheetName, WBName, FolderName
    If dbTotalOutput = 0 Then
        ReDim dbOutput(1 To 1) As Variant
        ReDim dbKey(1 To 1) As String
    End If
    For i = 1 To dbTotalOutput
        If dbKey(i) = FolderName & WBName & "!" & SheetName & "!" & RefName Then
            dbIndex = i
        End If
    If dbIndex = 0 Or refresh_memory Then
        If dbIndex = 0 Then
            dbTotalOutput = dbTotalOutput + 1
            dbIndex = dbTotalOutput
            ReDim Preserve dbOutput(1 To dbTotalOutput) As Variant
            ReDim Preserve dbKey(1 To dbTotalOutput) As String
            dbKey(dbIndex) = FolderName & WBName & "!" & SheetName & "!" & RefName
        End If
        If FolderName = "" Then
            Set dbOutput(dbIndex) = Workbooks(WBName).Worksheets(SheetName).Range(RefName)
        ElseIf Dir(FolderName & WBName) <> "" Then
            Set vExcel = CreateObject("Excel.Application")
            Set vWB = vExcel.Workbooks.Open(FolderName & WBName)
            With vWB.Sheets(SheetName)
                On Error GoTo ClearObject
                UserEndRow = .Range(RefName).Row + .Range(RefName).Rows.Count - 1
                UserEndCol = .Range(RefName).Column + .Range(RefName).Columns.Count - 1
                RealEndRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
                RealEndCol = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
                EndRow = IIf(UserEndRow < RealEndRow, UserEndRow, RealEndRow)
                EndCol = IIf(UserEndCol < RealEndCol, UserEndCol, RealEndCol)
                RangeHeight = EndRow - .Range(RefName).Row + 1
                RangeWidth = EndCol - .Range(RefName).Column + 1
                On Error Resume Next
                dbOutput(dbIndex) = .Range(RefName).Resize(RangeHeight, RangeWidth).Value
                If Err.Number <> 0 Then
                    IndirectEx = CVErr(xlErrNum)
                    GoTo ClearObject
                End If
            End With
            On Error GoTo ClearObject
            vWB.Close False
            Set vExcel = Nothing
            IndirectEx = CVErr(xlErrRef)
            Exit Function
        End If
    End If
    If TypeOf dbOutput(dbIndex) Is Range Then
        Set IndirectEx = dbOutput(dbIndex)
        IndirectEx = dbOutput(dbIndex)
    End If

    Exit Function
    On Error Resume Next
    If Not (vExcel Is Nothing) Then
        vWB.Close False
        Set vExcel = Nothing
    End If
End Function

Private Sub GetNames(ByVal ref_text As String, ByRef RefName As String, ByRef SheetName As String, ByRef WBName As String, ByRef FolderName As String)
    Dim P_e As Integer
    Dim P_b1 As Integer
    Dim P_b2 As Integer
    Dim P_s As Integer
    P_e = InStr(1, ref_text, "!")
    P_b1 = InStr(1, ref_text, "[")
    P_b2 = InStr(1, ref_text, "]")
    P_s = InStr(1, ref_text, ":\")
    If P_e = 0 Then
        RefName = ref_text
        RefName = Right$(ref_text, Len(ref_text) - P_e)
    End If
    RefName = Replace$(RefName, "$", "")
    If P_e = 0 Then
        SheetName = Application.Caller.Parent.Name
    ElseIf P_b1 = 0 Then
        SheetName = Left$(ref_text, P_e - 1)
        SheetName = Mid$(ref_text, P_b2 + 1, P_e - P_b2 - 1)
    End If
    SheetName = Replace$(SheetName, "'", "")
    If P_b1 = 0 Then
        WBName = Application.Caller.Parent.Parent.Name
        WBName = Mid$(ref_text, P_b1 + 1, P_b2 - P_b1 - 1)
    End If
    If P_s = 0 Then
        FolderName = ""
        FolderName = Left$(ref_text, P_b1 - 1)
    End If
    If Left$(FolderName, 1) = "'" Then FolderName = Right$(FolderName, Len(FolderName) - 1)
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
kbay808Author Commented:
Sorry for the long delay.  It works great.
Professor JMicrosoft Excel ExpertCommented:
You are welcome. Thanks for feedback.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.