Hello again

I know I've been posting a lot, but the workbook I'm currently working on
has no end of problems, and is probably beyond my capabilities. But there, I
have to do it! So I really appreciate any help that you could give me.

I'm trying to use a UDF (that was posted a while ago, so I can't ask the
author)
that I found on:

http://www.dailydoseofexcel.com/arch...ned-functions/

I want to Count every time a name appears in the same selection of cells
across multiple worksheets. I have copied the code in, and plugged in the
numbers but I get #VALUE! returned. My only theory is that some cells will be
empty and that confuses excel? What am I doing wrong!?!?

Thanks in advance!

The formula I enter is: =CountIf3D2('Blank 1:Blank 2'!A9:A10;A43)

The code relating to CountIf3D2 is as follows ( I think it also utilises the
function Parse3DRange2, which is also pasted below):

Function CountIf3D2(Range3D As String, Criteria As String) _
As Variant

Dim i As Long
Dim Count As Long
Dim vaRng1 As Variant

Application.Volatile

vaRng1 = Parse3DRange2(Application.Caller.Parent.Parent, Range3D)

Count = 0
For i = LBound(vaRng1) To UBound(vaRng1)
Count = Count + Application.WorksheetFunction.CountIf(vaRng1(i),
Criteria)
Next i

CountIf3D2 = Count

End Function

Function Parse3DRange2(wb As Workbook, _
SheetsAndRange As String) As Variant

Dim sTemp As String
Dim i As Long, j As Long
Dim Sheet1 As String, Sheet2 As String
Dim aRange() As Range
Dim sRange As String
Dim lFirstSht As Long, lLastSht As Long
Dim rCell As Range
Dim rTemp As Range

On Error GoTo Parse3DRangeError

sTemp = SheetsAndRange

'if it's 3d, rtemp will be nothing
On Error Resume Next
Set rTemp = Range(sTemp)
On Error GoTo Parse3DRangeError

'if it's 3d, parse it
If rTemp Is Nothing Then
i = InStr(sTemp, "!")
If i = 0 Then Err.Raise 9999

'next line will generate an error if range is invalid
'if it's OK, it will be converted to absolute form
sRange = Range(Mid$(sTemp, i + 1)).Address

sTemp = Left$(sTemp, i - 1)
i = InStr(sTemp, ":")
Sheet2 = Trim(Mid$(sTemp, i + 1))
If i 0 Then
Sheet1 = Trim(Left$(sTemp, i - 1))
Else
Sheet1 = Sheet2
End If

'next lines will generate errors if sheet names are invalid
With wb
lFirstSht = .Worksheets(Sheet1).Index
lLastSht = .Worksheets(Sheet2).Index

'swap if out of order
If lFirstSht lLastSht Then
i = lFirstSht
lFirstSht = lLastSht
lLastSht = i
End If

'load each cell into an array
j = 0
For i = lFirstSht To lLastSht
For Each rCell In .Sheets(i).Range(sRange)
ReDim Preserve aRange(0 To j)
Set aRange(j) = rCell
j = j + 1
Next rCell
Next i
End With

Parse3DRange2 = aRange
Else
'range isn't 3d, so just load each cell into array
For Each rCell In rTemp.Cells
ReDim Preserve aRange(0 To j)
Set aRange(j) = rCell
j = j + 1
Next rCell

Parse3DRange2 = aRange
End If

Parse3DRangeError:
On Error GoTo 0
Exit Function

End Function 'Parse3DRange

Category: Excel Experts E-Letter | Comment (RSS) | Trackback