Public Function MEGAV(ByVal src As Variant, ByVal shtRng As String, _
ByVal ex As Boolean, ParamArray cols() As Variant) As Variant
Dim choice As Boolean
Dim spl, spl2 As Variant
Dim results() As Variant
Dim srchRng As Range
Dim WB_check As Workbook
Dim R_FINAL() As String
Dim wb, sht, rng, col As String
Dim i, j, s, e, r, off2, off, colI As Integer
ReDim results(0 To 0) As Variant
choice = IsNumeric(src)
r = 0
If InStr(shtRng, "]") Then
spl = Split(shtRng, "]")
wb = Right(spl(0), (Len(spl(0)) - 1))
shtRng = spl(1)
Else
wb = Application.Caller.Parent.Parent.Name
End If
On Error Resume Next
Set WB_check = Workbooks(wb)
If WB_check Is Nothing Then
MsgBox ("Workbook: " & wb & " needs to be opened for this function")
MEGAV = "WB Err"
Exit Function
End If
If InStr(shtRng, "!") Then
spl = Split(shtRng, "!")
sht = spl(0)
rng = spl(1)
If InStr(sht, "'") Then
spl = Split(sht, "'")
sht = spl(1)
End If
Else
rng = shtRng
sht = Application.Caller.Parent.Name
End If
off2 = colNumber(rng, 0)
With Workbooks(wb).Sheets(sht)
Set srchRng = .Range(rng)
For i = LBound(cols) To UBound(cols)
col = cols(i)
ReDim Preserve results(0 To r) As Variant
If InStr(col, ":") Then
spl2 = Split(col, ":")
s = 0
e = 0
If IsNumeric(spl2(0)) Then
s = CInt(spl2(0))
e = CInt(spl2(1))
Else
s = colNumber(col, 0)
e = colNumber(col, 1)
End If
If i = 0 Then
off = s - off2 + 1
If choice Then
results(r) = Application.WorksheetFunction.VLookup(CDbl(src), srchRng, off, ex)
r = r + 1
Else
results(r) = Application.WorksheetFunction.VLookup(CStr(src), srchRng, off, ex)
r = r + 1
End If
s = s + 1
End If
For j = s To e
ReDim Preserve results(0 To r) As Variant
off = j - off2 + 1
If choice Then
results(r) = Application.WorksheetFunction.VLookup(CDbl(src), srchRng, off, ex)
r = r + 1
Else
results(r) = Application.WorksheetFunction.VLookup(CStr(src), srchRng, off, ex)
r = r + 1
End If
Next j
Else
If IsNumeric(col) Then
colI = CInt(col)
Else
colI = colNumber(col, 0)
End If
off = colI - off2 + 1
If choice Then
results(r) = Application.WorksheetFunction.VLookup(CDbl(src), srchRng, off, ex)
r = r + 1
Else
results(r) = Application.WorksheetFunction.VLookup(CStr(src), srchRng, off, ex)
r = r + 1
End If
End If
Next i
End With
MEGAV = results
End Function
Private Function colNumber(ByVal str As String, ByVal index As Integer)
Dim spl As Variant
Dim col As String
Dim l, j As Integer
l = 1
If InStr(str, ":") Then
spl = Split(str, ":")
col = Left(spl(index), 1)
l = Len(col)
Else
col = Left(str, 1)
l = Len(col)
End If
For j = 1 To l
colNumber = (Asc(UCase(Mid(col, j, 1))) - 64) + colNumber * 26
Next j
End Function
|