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

kbay808
kbay808 used Ask the Experts™
on
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?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Sam JacobsCitrix Technology Professional / Director of TechDev Services, IPM

Commented:
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.
control.xlsm
countA.xlsx

Author

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 JacobsCitrix Technology Professional / Director of TechDev Services, IPM

Commented:
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?

Author

Commented:
Yes I can, as a backup measure.  I still hoping that we can somehow add the below line to your code.
WorksheetFunction.CountA(Range("A1:A"))

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

COUNTA should work, just tested.
Count on Sheet1, column A in workbook C:\Test\Data.xlsx
=COUNTA('C:\Test\[Data.xlsx]Sheet1'!$A:$A)

You can use SUMPRODUCT to do the same
=SUMPRODUCT(('C:\Test\[Data.xlsx]Sheet1'!$A:$A<>"")*1)

Author

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 LambertConsulting
Distinguished Expert 2017

Commented:
Hi,

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.

@Ejgil:
This kind of formula work, but absolute path can be a problem.
Microsoft Excel Expert
Top Expert 2014
Commented:
kbay808
 
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.

zfdsf.jpg



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
    Next
    
    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
            vExcel.Quit
            Set vExcel = Nothing
        Else
            IndirectEx = CVErr(xlErrRef)
            Exit Function
        End If
    End If
    
    If TypeOf dbOutput(dbIndex) Is Range Then
        Set IndirectEx = dbOutput(dbIndex)
    Else
        IndirectEx = dbOutput(dbIndex)
    End If

    Exit Function
    
ClearObject:
    On Error Resume Next
    If Not (vExcel Is Nothing) Then
        vWB.Close False
        vExcel.Quit
        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
    Else
        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)
    Else
        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
    Else
        WBName = Mid$(ref_text, P_b1 + 1, P_b2 - P_b1 - 1)
    End If
    
    If P_s = 0 Then
        FolderName = ""
    Else
        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

Source-File.xlsx
MAIN-Workbook.xlsm

Author

Commented:
Sorry for the long delay.  It works great.
Professor JMicrosoft Excel Expert
Top Expert 2014

Commented:
You are welcome. Thanks for feedback.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial