# VBA Search Value from other sheet and return data



## tbxor (Dec 18, 2022)

Test.xlsmABCDEFG112/18/202216:31:51Host WWIDGuest Badge IDGuest NameContact NumberBadge No212/18/202216:04:471212008813465789John1234567KK5-1312/18/202216:05:011212880013245646Doe1324658KK5-2412/18/202216:05:451216777813244587Lucy1456738KK5-3512/18/202216:05:541216777856478974Aaron1897654612/18/202216:05:591277888813264894Joseph1348795712/18/202216:06:051277888814654987Isaac1354879Dec22

Test.xlsmABC1NoGuest Badge IDOrigin2113465789KK53213245646KK54313244587KK55456478974KK56113264894KD27214654987KD2BadgeList

There's multiple guest badge origin. KK5 and KD2. All of them listed in badge list sheet. I need to lookup the value of Guest Badge ID, 5th column in Dec22 sheet. Get the data from Badge List sheet and set the value of Badge No column in Dec22 sheet to be a combination of Origin and Badge No as shown in G2 until G4.


----------



## Alex Blakenburg (Dec 18, 2022)

Is this what you mean ?

Book2ABCDEFG112/18/202216:31:51Host WWIDGuest Badge IDGuest NameContact NumberBadge No218/12/20220.6699881212008813465789John1234567KK5-1318/12/20220.670151212880013245646Doe1324658KK5-2418/12/20220.670661216777813244587Lucy1456738KK5-3518/12/20220.6707641216777856478974Aaron1897654KK5-4618/12/20220.6708221277888813264894Joseph1348795KD2-1718/12/20220.6708911277888814654987Isaac1354879KD2-2Dec22Cell FormulasRangeFormulaG2:G7G2=XLOOKUP(D2, BadgeList!$B$2:$B$100, BadgeList!$C$2:$C$100 & "-" & BadgeList!$A$2:$A$100)


----------



## tbxor (Dec 18, 2022)

Alex Blakenburg said:


> Is this what you mean ?
> 
> Book2ABCDEFG112/18/202216:31:51Host WWIDGuest Badge IDGuest NameContact NumberBadge No218/12/20220.6699881212008813465789John1234567KK5-1318/12/20220.670151212880013245646Doe1324658KK5-2418/12/20220.670661216777813244587Lucy1456738KK5-3518/12/20220.6707641216777856478974Aaron1897654KK5-4618/12/20220.6708221277888813264894Joseph1348795KD2-1718/12/20220.6708911277888814654987Isaac1354879KD2-2Dec22Cell FormulasRangeFormulaG2:G7G2=XLOOKUP(D2, BadgeList!$B$2:$B$100, BadgeList!$C$2:$C$100 & "-" & BadgeList!$A$2:$A$100)


it does the trick but I'll need to use VBA since my colleagues are mostly old people with low general knowledge of excel


----------



## Alex Blakenburg (Dec 18, 2022)

How does VBA help ?  I would imagine that would make it even harder for your audience.


----------



## tbxor (Dec 18, 2022)

Alex Blakenburg said:


> How does VBA help ?  I would imagine that would make it even harder for your audience.


It'll be helpul since the VBA code is not visible on front end. They can't tamper the cell formula that way.


----------



## Alex Blakenburg (Dec 18, 2022)

OK give this a try:


```
Sub LookupBadgeID()

    Dim shtAct As Worksheet, shtBadge As Worksheet
    Dim rngFormula As Range, rngBadge As Range
    Dim LRowAct As Long, LRowBadge As Long
    Dim strFormula As String
    
    
    Set shtAct = ActiveSheet
    Set shtBadge = Worksheets("BadgeList")
    
    With shtAct
        LRowAct = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngFormula = .Range(.Cells(2, "G"), .Cells(LRowAct, "G"))
    End With
    
    With shtBadge
        LRowBadge = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngBadge = .Range(.Cells(2, "A"), .Cells(LRowBadge, "C"))
    End With

    strFormula = "=XLOOKUP(D2, BadgeList!$B$2:$B$~LR, BadgeList!$C$2:$C$~LR & "" - "" & BadgeList!$A$2:$A$~LR)"
    strFormula = Replace(strFormula, "~LR", LRowBadge)
    
    rngFormula.Formula2 = strFormula
    rngFormula.Value2 = rngFormula.Value2

End Sub
```


----------



## tbxor (Dec 18, 2022)

the lookup code took quite a few seconds to be completed. Amending the data of the cells involved in lookup range will also loads a bit more after cell change.


----------



## Alex Blakenburg (Dec 18, 2022)

tbxor said:


> Amending the data of the cells involved in lookup range will also loads a bit more after cell change.


What does that mean ?

How many rows of data are we talking ? It would need to be rewritten using a dictionary to speed it up. I wouldn't be able to look at that until much later today. 
(I am in Australia)


----------



## tbxor (Dec 18, 2022)

Alex Blakenburg said:


> What does that mean ?
> 
> How many rows of data are we talking ? It would need to be rewritten using a dictionary to speed it up. I wouldn't be able to look at that until much later today.
> (I am in Australia)


this is the reply for earlier xlookup in front end. not vba. what i meant is. when i add a new badge in badge list sheet, it'll load around 2 3 secs.


----------



## tbxor (Dec 18, 2022)

Alex Blakenburg said:


> OK give this a try:
> 
> 
> ```
> ...


This will also take a while to complete since it checks all row in column G. I think maybe just check for guest badge number whenever I edit column D in Dec22 sheet.


----------



## tbxor (Dec 18, 2022)

Test.xlsmABCDEFG112/18/202216:31:51Host WWIDGuest Badge IDGuest NameContact NumberBadge No212/18/202216:04:471212008813465789John1234567KK5-1312/18/202216:05:011212880013245646Doe1324658KK5-2412/18/202216:05:451216777813244587Lucy1456738KK5-3512/18/202216:05:541216777856478974Aaron1897654612/18/202216:05:591277888813264894Joseph1348795712/18/202216:06:051277888814654987Isaac1354879Dec22

Test.xlsmABC1NoGuest Badge IDOrigin2113465789KK53213245646KK54313244587KK55456478974KK56113264894KD27214654987KD2BadgeList

There's multiple guest badge origin. KK5 and KD2. All of them listed in badge list sheet. I need to lookup the value of Guest Badge ID, 5th column in Dec22 sheet. Get the data from Badge List sheet and set the value of Badge No column in Dec22 sheet to be a combination of Origin and Badge No as shown in G2 until G4.


----------



## Alex Blakenburg (Dec 19, 2022)

See if this works for you.


```
Sub LookupBadgeID_dic()

    Dim shtAct As Worksheet, shtBadge As Worksheet
    Dim rngActResult As Range, rngActID As Range, rngBadge As Range
    Dim arrBadge As Variant, arrActID As Variant
    Dim LRowAct As Long, LRowBadge As Long
    Dim dictBadge As Object, dictKey As String
    Dim i As Long
    
    Set shtAct = ActiveSheet
    Set shtBadge = Worksheets("BadgeList")
    
    With shtAct
        LRowAct = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngActID = .Range(.Cells(2, "D"), .Cells(LRowAct, "D"))
        Set rngActResult = .Range(.Cells(2, "G"), .Cells(LRowAct, "G"))
        arrActID = rngActID.Value2
        ReDim Preserve arrActID(1 To UBound(arrActID), 1 To 2)
    End With
    
    With shtBadge
        LRowBadge = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngBadge = .Range(.Cells(2, "A"), .Cells(LRowBadge, "C"))
        arrBadge = rngBadge.Value2
    End With
    
    Set dictBadge = CreateObject("Scripting.dictionary")
    
    ' Load badge lookup range into Dictionary
    For i = 1 To UBound(arrBadge)
        dictKey = arrBadge(i, 2)
        If Not dictBadge.exists(dictKey) Then
            dictBadge(dictKey) = i
        End If
    Next i
    
    ' For Lookup return value get values from Dictionary
    For i = 1 To UBound(arrActID)
        dictKey = arrActID(i, 1)
        If dictBadge.exists(dictKey) Then
            arrActID(i, 2) = arrBadge(dictBadge(dictKey), 3) & "-" & arrBadge(dictBadge(dictKey), 1)
        End If
    Next i
    
    rngActResult.Value2 = Application.Index(arrActID, 0, 2)

End Sub
```


----------



## tbxor (Dec 19, 2022)

Alex Blakenburg said:


> See if this works for you.
> 
> 
> ```
> ...


Can you fiddle a code that checks for a targeted cell change using Worksheet_Change target.column? for example, when I edit the value of D2, it will trigger an xlookup


----------



## Alex Blakenburg (Dec 19, 2022)

Try this:- 

```
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rngChg As Range, rCell As Range
    Dim shtBadge As Worksheet
    Dim rngBadge As Range
    Dim LRowBadge As Long
    
    Set rngChg = Intersect(Target, Columns("D"))

    If Not rngChg Is Nothing Then
        Application.EnableEvents = False
        Set shtBadge = Worksheets("BadgeList")
        With shtBadge
            LRowBadge = .Range("A" & Rows.Count).End(xlUp).Row
            Set rngBadge = .Range(.Cells(2, "A"), .Cells(LRowBadge, "C"))
        End With
    
        For Each rCell In rngChg
             rCell.Offset(, 3).Value2 = Application.XLookup(rCell, rngBadge.Columns(2), rngBadge.Columns(3)) & "-" & _
                                                Application.XLookup(rCell, rngBadge.Columns(2), rngBadge.Columns(1))
        Next rCell
        Application.EnableEvents = True
    End If

End Sub
```


----------



## tbxor (Dec 19, 2022)

Alex Blakenburg said:


> Try this:-
> 
> ```
> Private Sub Worksheet_Change(ByVal Target As Range)
> ...


niiiiiicceeeee. thaannnk youuuu!


----------



## Alex Blakenburg (Dec 19, 2022)

No problem. Glad we got it working for you.


----------

