Made function VBA code Concatif..... help to let this module work on two sheets?

[coxash123]

Can anyone help with this module code. I simple want this funtion to work on both active sheets named within the code.... I think i have been working on this too long. Any suggestions will be greatly appreciated.

Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, Optional Delimiter As String, Optional NoDuplicates As Boolean) As String

'Performance fix - only run if target sheet is active
Dim s As String
s = ActiveSheet.Name
d = Acitvesheet.Name

If s <> "Target Grid" Then
Exit Function
If d <> "Target Grid Grades" Then
End If


Application.ScreenUpdating = False
Application.EnableEvents = False

Dim i As Long, j As Long
With compareRange.Parent
Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
End With
If compareRange Is Nothing Then Exit Function
If stringsRange Is Nothing Then Set stringsRange = compareRange
Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, stringsRange.Column - compareRange.Column)

Dim hasItems As Boolean

hasItems = False

For i = 1 To compareRange.Rows.Count
For j = 1 To compareRange.Columns.Count
If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j))
hasItems = True
End If
End If
Next j
Next i


If hasItems Then
ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1) + ChrW(10) + ChrW(10)
Else
ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1)
End If


Application.EnableEvents = True
Application.ScreenUpdating = True


End Function

 

[MARK858]

Both sheets cannot be active at the time the code is run. Only one sheet can be the activesheet at a time so s and d are referring to the same sheet.

'Performance fix - only run if target sheet is active
Dim s As String
[COLOR="#FF0000"]s = ActiveSheet.Name
d = Acitvesheet.Name[/COLOR]

If s <> "Target Grid" Then

 

[coxash123]

How do I correct the VBA code to have it working when either sheet is active ?

 

[mikerickson]

I'm the original author of that code.
It is a UDF, and as such, it returns a value depending on the arguments. It works on any sheet, in the sense that either the compareRange or the stringsRange can be on any sheet of an open workbook. (Those are the only range arguments)

If you want the UDF to work on only particular sheets, then make sure that all of the arguments passed to the UDF are on the desired sheet.

Since the UDF does not change environment, the toggling of Application.ScreenUpdating isn't needed. (Not changing the environment is need, since the UDF is intended to be used in worksheet formulas.)

Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
    Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
    Rem original version
    Dim i As Long, j As Long
    With compareRange.Parent
        Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
    End With
    If compareRange Is Nothing Then Exit Function
    If stringsRange Is Nothing Then Set stringsRange = compareRange
    Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
    stringsRange.Column - compareRange.Column)
     
    For i = 1 To compareRange.Rows.Count
        For j = 1 To compareRange.Columns.Count
            If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
                If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
                    ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j))
                End If
            End If
        Next j
    Next i
    ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1)
End Function

What do you want to do with the ConcatIf UDF?