Snasui Excel Forum

Code: Select all

'
'
'
Dim fs As Variant
Dim nb As Integer
    fs = Application.Transpose(a)
    nb = Application.CountA(fs)

    
    SearchContact_Func = nb
'
'
'

Code: Select all

Function SearchContact_Func_join(f As Range, c As Range) As String
    Dim s As String, a() As Variant, b As Variant
    Dim xlApp As Application, wb As Workbook
    Dim i As Long, j As Long, k As Long
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Worksheets("Sheet1")
        s = LCase(c.Value)
        Set wb = xlApp.Workbooks.Open(Filename:=f.Value, ReadOnly:=True)
    End With
    j = 0
    With wb.Sheets(1)
        .Range("a3").CurrentRegion.EntireRow.Hidden = False
        b = .Range("a8", .Range("a" & .Rows.Count).End(xlUp)).Resize(, 51)
        For i = 1 To UBound(b)
            For k = 1 To 51
                If InStr(LCase(b(i, k)), s) Then
                    ReDim Preserve a(j)
                    a(j) = b(i, 1)
                    j = j + 1
                    Exit For
                End If
            Next k
        Next i
    End With
    wb.Close False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    SearchContact_Func_join = VBA.Join(a, ",")
End Function

Code: Select all

Function SJ(f As Range, c As Range) As String
Dim a, l As Long, wb As Workbook, j As String, Ap As Application
Application.ScreenUpdating = False
    Set Ap = CreateObject("Excel.Application")
    Set wb = Ap.Workbooks.Open(Filename:=f.Value, ReadOnly:=True)
    With wb.Sheets(1)
        l = .Cells(Rows.Count, 1).End(xlUp)
        a = .Evaluate(Replace("Transpose(IF(MMULT(N(ISNUMBER(SEARCH(""" & c & """,B8:AY#))),TRANSPOSE(COLUMN(B1:AY1)^0)),A8:$A#))", "#", l))
    End With
    wb.Close
    a = Filter(a, False, False)
    For l = 0 To UBound(a)
        j = j & "," & Application.Text(a(l), "d-mmm-yy;;")
    Next
    SJ = Mid(j, 2)
Application.ScreenUpdating = True
End Function