***WINNERS ANNOUNCEMENT*** June/July 2008 Challenge of the Month

[Derek Brown]

Re: June/July 2008 Challenge of the Month

An update to my solution of 9th July, with a change of function name to ReverseVLOOKUP, this includes more argument validation and the option to check the entire content of the cell.

Function ReverseVLOOKUP(rngCell As Range, rngTable As Range, lngColumn As Long, _
    Optional blEntireCellContent As Boolean) As String
Application.Volatile
Dim rng As Range
Dim blEntireCell As Boolean
If ((lngColumn > rngTable.Columns.Count) Or (lngColumn < 1) Or _
    (rngCell.Columns.Count > 1) Or (rngCell.Rows.Count > 1)) Then
    ReverseVLOOKUP = "#REF!"
    Exit Function
End If
If IsMissing(blEntireCellContent) Then
    blEntireCell = False
Else
    blEntireCell = blEntireCellContent
End If
For Each rng In rngTable.Columns(1).Cells
    If blEntireCell Then
        If rngCell.Value = rng.Value Then
            ReverseVLOOKUP = Cells(rng.Row, rng.Column + lngColumn - 1)
            Exit For
        End If
    ElseIf InStr(1, rngCell.Value, rng.Value) > 0 Then
        ReverseVLOOKUP = Cells(rng.Row, rng.Column + lngColumn - 1)
        Exit For
    End If
Next rng
Set rng = Nothing
End Function

The first argument is the lookup value, the second is the table array, the third is the column to return and the new argument is a boolean (true or false) to indicate whether the entire cell is to match.

 

[Derek Brown]

Re: June/July 2008 Challenge of the Month

Perhaps I should add that if the last argument is set to TRUE, the function will perform in the same way as VLOOKUP. However, it is possible to set that last argument to a specific cell reference and then be able to 'switch' between the two types of result by just changing the value of one cell.

 

[stanleydgromjr]

Re: June/July 2008 Challenge of the Month

My last try (shorter code).

Thank you Daniel Ferry.


Thanks, had a lot of fun with this.

Option Explicit
Sub ColorAssignedTo()
    Dim LRA&, LRD&
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        LRA& = Cells(Rows.Count, 1).End(xlUp).Row
        LRD& = Cells(Rows.Count, 4).End(xlUp).Row
        Range("B2:B" & LRA&).FormulaR1C1 = "=LOOKUP(32767,FIND(R2C[2]:R" & LRD& & "C[2],RC[-1]),R2C[3]:R" & LRD& & "C[3])"
        .CutCopyMode = False
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Have a great day,
Stan

 

[bosco_yip]

Re: June/July 2008 Challenge of the Month

1] =lookup(2,1/find(d$2:d$10,a2),e$2:e$10)

2] =lookup(0,1/find(d$2:d$10,a2)-1,e$2:e$10)

3] {=index($e$2:$e$10,match(1,--isnumber(find($d$2:$d$10,a2)),0),0)}

 

[lostramc]

Re: June/July 2008 Challenge of the Month

Here's one possibility.....

=LOOKUP(2^15,SEARCH(D$2:D$10,A2),E$2:E$10)

Could someone explain how this works?
I have tried dissecting it and looking in Excels help file for the Lookup function but still can't figure it out.

 

[schielrn]

Re: June/July 2008 Challenge of the Month

Could someone explain how this works?
I have tried dissecting it and looking in Excels help file for the Lookup function but still can't figure it out.

See Richard's explanation here:

http://www.mrexcel.com/forum/showpost.php?p=1599318&postcount=34

Hope that helps.

 

[EugeneCarter]

Re: June/July 2008 Challenge of the Month

I know i'm late, and there's a billion posts, but I just found this "challenge of the month" and I thought I'd throw what I came up with, and my apologies if someone already posted this.

=INDEX($E$2:$E$10,SUMPRODUCT(--NOT(ISERROR(SEARCH($D$2:$D$10,$A2)))*(ROW($D$2:$D$10)-1)))

 

[andrewman]

Re: June/July 2008 Challenge of the Month

Please give me a chance to read my code. Thanks!

Option Explicit
Private Function Vlookups(Key As Variant, Area As Range, Col As Integer, m As Boolean) As Variant
Dim SKey As Variant
SKey = S(Key, Area)
If SKey = "" Then
Vlookups = "Not yet assigned"
Else
Vlookups = Application.WorksheetFunction.VLookup(SKey, Area, Col, m)
End If
End Function

Private Function S(Key As Variant, ByVal list As Range) As Variant
Dim n As Variant
Set list = list.Resize(list.Rows.Count, 1)

For Each n In list
If InStr(1, Key, n.Value, vbTextCompare) > 0 Then
S = n.Value
Exit For
End If
Next n

End Function



Andrew Man
From Hong Kong

 

[andrewman]

Re: June/July 2008 Challenge of the Month

How about ?
UDF
=VLookLike(A2, $E$2:$E$10)

Function VLookLike(txt As Variant, rng As Range) As Variant
Dim myPtn As String
myPtn = "(" & Join(WorksheetFunction.Transpose(rng.Columns(1).Value),"|") & ")"
With CreateObject("VBScript.RegExp")
    .Pattern = myPtn
    If .test(txt.Value) Then myMatch = .execute(txt.Value)(0)
End With
VLookLike = rng.Columns(2).Cells(WorksheetFunction.Match(myMatch,rng.Columns(1),0)).Value
End Function

After I posted my answer, I read all the code. I only like the code from Jindon. I am not fully understand how it work. But, I can you his method to solve some of my old problems now.

Moreover, I think we should be more creative to use the code. I have seen a lot of code lookup & index ....... Most of the code logic is the same, I think it had already post in the another thread which I seen a lots here!! We should read more and then create our own code.

Jindon, Nice to meet you here! I guess you are the best.

I hope you can give me of your email. Thus, we can discuss more about the Excel problems from user.

Regards,

Andrew Man
From Hong Kong

 

[andrewman]

Re: June/July 2008 Challenge of the Month

VBA can use the Regular Expression which just like OpenOffice worked.

Jindon has demonstrated the method how the use the Regular Expression in VBA.

Do you think is suitable?

Andrew Man
From Hong Kong