0

I'm scratching my head here and really hope someone can point me in the right direction.

I'm trying to create a VBA function to count unique occurances of text within a range and am using a variation of code found online to achieve that.

Essentially the code (below) does the following:

  • Create a temporary workbook
  • Copies a deduplicated list of the text across to that workbook
  • Count how many rows that equates to.

This is the code I have so far:

Public Function TestingMe() As Long
Dim numrows As Long
Dim rng As Range
Dim tempwb As Workbook, origwb As Workbook

Set origwb = ActiveWorkbook
Set tempwb = Workbooks.Add

Set rng = tempwb.Sheets(1).Range("A1")

origwb.Worksheets("data").Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rng, Unique:=True

numrows = tempwb.Application.WorksheetFunction.CountA(tempwb.Sheets(1).Range("A:A").EntireColumn)
tempwb.Close (False)
Set origwb = Nothing
Set tempwb = Nothing

Debug.Print (numrows)
TestingMe = numrows
End Function

The code works perfectly fine when ran through the Immediate window of the code editor, but when used as a function from within a worksheet the "COUNTA" function is looking at the first sheet of the origwb rather than the temporary workbook where the de-duplicated data has been copied to.

It seems like it's a reference/scoping issue but as you can see, I've tried in the code to specifically reference everthing to attempt to fix the issue but with no joy.

Any pointers would really be appreciated.

Thanks in advance Martin

Martin P
  • 41
  • 2
  • Does the code in the accepted answer help you? http://stackoverflow.com/questions/1676068/count-unique-values-in-excel or maybe you should change `Set rng = tempwb.Sheets(1).Range("A1")` to `Set rng = tempwb.Sheets(1).Range("A:A")`? – RCaetano Sep 20 '16 at 11:21
  • A UDF called from a cell can't add a new workbook nor can it do an advanced filter. – Rory Sep 20 '16 at 11:27
  • @Rory - bugger, thanks. Looks like I'll need to try another method. – Martin P Sep 20 '16 at 11:43
  • @ RCaetano - it helps, but it's incredibly slow when it comes to larger datasets unfortunately, so I'm looking for a faster mechanism if possible – Martin P Sep 20 '16 at 11:43
  • You are just setting a range, that should not take so long even with larger datasets, as far as I know :) – RCaetano Sep 20 '16 at 11:46
  • @Rory, see workaround to have a function change the "environment" – user3598756 Sep 20 '16 at 14:33
  • @user3598756 See my comments on your workaround. :) – Rory Sep 20 '16 at 14:35
  • @MartinP I suggest you load the data into an array, from there into a Dictionary or Collection and then count the result. – Rory Sep 20 '16 at 14:37
  • @Rory, my real aim was to find a way to have a function add a workbook and autofilter a worksheet. That's all – user3598756 Sep 20 '16 at 14:45
  • @user3598756 But you haven't really achieved that in my opinion. It's the act of typing in the cell that actually does the work. The function itself is somewhat irrelevant, is it not? – Rory Sep 20 '16 at 14:46
  • @Rory, there's an _actual_ connection to the specific function via the "code" (-9999 in this case) that drives the change event. Again, it was more for fun than for real use! – user3598756 Sep 20 '16 at 14:52
  • @user3598756 Not really - typing -9999 in any cell on the sheet would trigger the code, regardless of the function's presence or otherwise. Anyway, I digress, so that's enough for me. – Rory Sep 20 '16 at 14:55
  • @Rory, the point was choosing a code quite improbable to be typed in any cell for any reason: -9999 was just an example. But I also agree it's enough. Thank you for your comments which I think improved the understanding of my actually provocative proposal – user3598756 Sep 20 '16 at 15:31

4 Answers4

0

It appears from your explanation that origwb refers to wrong workbook when run from sheet COUNTA. Try below code. Replace "ActualWorkbookname" with the name of workbook you want to refer as origwb. Make sure this workbook is already opened.

Workbooks("ActualWorkbookname.XLSX").Activate
Set origwb = ActiveWorkbook
Mukul Varshney
  • 3,131
  • 1
  • 12
  • 19
  • Won't work either I'm afraid - as previously commented, it appears that creating a new workbook from a worksheet called UDF isn't possible – Martin P Sep 20 '16 at 12:10
  • The COUNTA is being called in the VBA function to count the result of the (unsuccessfully) copied advancedfilter data on the temp workbook – Martin P Sep 20 '16 at 12:19
0

The problem results from the fact you should consider na extra top row for a header while applying the filter for unique values. If you add a MsgBox "stop" before tempwb.Close (False) you will se that the value from the origwb is not being correctly filtered, like in this example:

Initialy in origwb:

1
2
3
2
2
5
4
1
1

and you will get in tempwb:

1
2
3
5
4
1

Note that the first 1 is not being considered and so it appears in the last row also, leading to an incorrect value from Application.WorksheetFunction.CountA.

Solution:

  1. Make the cell A1 line of origwb without relevant data before filtering to act as na header, like "temp".
  2. Subtract 1 from numrows in numrows = tempwb.Application.WorksheetFunction.CountA(tempwb.Sheets(1).Range("A:A").EntireColumn) - 1
RCaetano
  • 642
  • 1
  • 8
  • 23
  • The problem is that it appears UDFs called from a worksheet won't allow creation of a new workbook (as per Rory's comment above). I've "proved" this by stepping through the UDF and iterating through the Workbooks collection and the tempwb workbook does not exist. I also confirmed that the AdvancedFilter option doesn't appear to be usable from the UDF either as I changed the code to add a worksheet to the existing workbook (instead of creating a new wb) and attempting to use the advancedfilter on that worksheet with no joy. – Martin P Sep 20 '16 at 12:05
0

You could try this workaround

Collapse your function to:

Function TestingMe() As Long
    TestingMe = -9999
End Function

Add this code in any module

Sub DoWorkForTestingMe(Target As Range)
    Dim numrows As Long
    Dim rng As Range
    Dim tempwb As Workbook, origwb As Workbook

    Set origwb = ActiveWorkbook
    Set tempwb = Workbooks.Add

    Set rng = tempwb.Sheets(1).Range("A1")

    origwb.Worksheets("data").Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rng, Unique:=True

    numrows = tempwb.Application.WorksheetFunction.CountA(tempwb.Sheets(1).Range("A:A").EntireColumn)
    tempwb.Close (False)
    Set origwb = Nothing
    Set tempwb = Nothing
    Target.Value = numrows
End Sub

Add the following code in the code pane of the worksheet you want to use that function in:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Value <> -9999 Then Exit Sub
    Application.EnableEvents = False
    On Error GoTo ExitSub
    DoWorkForTestingMe Target
ExitSub:
    Application.EnableEvents = True
End Sub
user3598756
  • 28,893
  • 4
  • 18
  • 28
  • A formula calculation doesn't trigger a `Change` event other than when you initially enter the formula. Also, your formula would never recalculate. – Rory Sep 20 '16 at 14:35
  • @Rory, it does trigger as I tested it. As for the recalculation I know that but I got that was not needed by OP – user3598756 Sep 20 '16 at 14:37
  • It only triggers when you **first** enter the formula. I don't see how that helps here. If a static result is required, there is no need for a function at all. – Rory Sep 20 '16 at 14:39
  • @Rory, it helps only in that it shows a way to have a Function add a workbook and autofilter a worksheet. Just fun... – user3598756 Sep 20 '16 at 14:47
0

This code uses Collections and User-Defined Functions:

Function countUnique(r As range) As Long
    'Application.Volatile False ' optional
    Set r = Intersect(r, r.Worksheet.UsedRange) ' optional
    Dim c As New Collection, v
    On Error Resume Next ' to ignore the Run-time error 457: "This key is already associated with an element of this collection".
    For Each v In r.Value ' remove .Value for ranges with more than one Areas
        c.Add 0, v & ""
    Next
    c.Remove "" ' optional to exclude blanks from the count
    countUnique = c.Count
End Function
Graham
  • 7,431
  • 18
  • 59
  • 84
Slai
  • 22,144
  • 5
  • 45
  • 53