Find Names in list based on Values VBA

[Brentsa]

I have a table with a list of names can be up to 1000 rows and values in 2 columns. So for small example:

Amal	71	75
Blackcurrant	38	38
Cantaloupe	100	100
Cempedak	37	37
Cherimoya (Custard Apple)	87	88
Elderberry	77	77
Feijoa	87	87
Fig	54	45
Grape	9	9
Grapefruit	21	21
Guava	24	24
Loganberry	76	76
Lychee	86	80
Mangosteen	91	91
Melon	71	71
Miracle fruit	94	94
Mulberry	74	74
Pineberry	42	42
Plum	4	14
Plumcot (or Pluot)	89	89
Salmonberry	15	15
Tayberry	38	36
Watermelon	40	40
Yuzu	75	75

I want to search for the following values so that I can get the names. The values can either be in Column B or C or both. I want to paste the numbers I'm looking for in column G and the results to appear in Column H and I
24
38
45
71
40
88

I would then like to see the results as follows with duplicate numbers highlighting the entire row.

24​	Guava
38​	Tayberry
38​	Blackcurrant
45​	Fig
71​	Melon
71​	Amal
40​	Watermelon
88​	Cherimoya (Custard Apple)

 

[Trebor76]

Hi Brentsa,

Not sure what you mean by "duplicate numbers highlighting the entire row" but this will do everything else you're asking for (assumes data starts at Row 2):

Option Explicit
Sub Macro1()

    Dim clnMyItems As New Collection
    Dim varTemp As Variant
    Dim lngLastRow As Long, lngMyRow As Long, lngPasteRow As Long, lngArrayCount As Long
    Dim strMyNumbers() As String
   
    Application.ScreenUpdating = False
   
    lngLastRow = Cells(Rows.Count, "G").End(xlUp).Row
    For lngMyRow = 2 To lngLastRow
        lngArrayCount = lngArrayCount + 1
        ReDim Preserve strMyNumbers(1 To lngArrayCount) 'Append the current record to the 'strMyNumbers' array
        strMyNumbers(lngArrayCount) = Range("G" & lngMyRow)
    Next lngMyRow
   
    lngLastRow = Range("A:C").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For lngMyRow = 2 To lngLastRow
        On Error Resume Next
            If IsNumeric(Application.Match(CStr(Range("B" & lngMyRow)), strMyNumbers, 0)) = True Then
                clnMyItems.Add Range("B" & lngMyRow) & "|" & Range("A" & lngMyRow), CStr(Range("B" & lngMyRow) & "|" & Range("A" & lngMyRow))
            End If
            If IsNumeric(Application.Match(CStr(Range("C" & lngMyRow)), strMyNumbers, 0)) = True Then
                clnMyItems.Add Range("C" & lngMyRow) & "|" & Range("A" & lngMyRow), CStr(Range("C" & lngMyRow) & "|" & Range("A" & lngMyRow))
            End If
        On Error GoTo 0
    Next lngMyRow
   
    For Each varTemp In clnMyItems
        On Error Resume Next
            lngPasteRow = Range("H:I").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        On Error GoTo 0
        If lngPasteRow = 0 Then
            lngPasteRow = 2
        Else
            lngPasteRow = lngPasteRow + 1
        End If
        Range("H" & lngPasteRow).Value = Split(varTemp, "|")(0)
        Range("I" & lngPasteRow).Value = Split(varTemp, "|")(1)
    Next varTemp
   
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

 

[Brentsa]

Hi Brentsa,

Not sure what you mean by "duplicate numbers highlighting the entire row" but this will do everything else you're asking for (assumes data starts at Row 2):

I wanted to use something like conditional format to highlight which amounts are duplicated and with which products.

You VBA works on test thanks