Find, Copy Equivalent, Paste in Different Sheet

[Stonesteel]

Greetings!

Microsoft Excel 2007

Can you guys assist me, I am using Excel2007. I want to make a vba formula that will find a certain value in another sheet then will paste its equivalent value to another sheet. let's have an example.

i have this ESN "0A003ED50503" currently in cell "D384" in sheet "Status" and i want to find it in column "B" in another sheet "Licenses", and if found, i will copy its equivalent which i called "License" and will paste to another cell "M384" same row as ESN in the source sheet (Status).

Note: please do not suggest of using Vlookup, I already tried it and it responds for a long time since single change in a row where vlookup is located will make it scan for changes, i have 977 thousand licenses in Licenses Sheet. imagine how long it will scan. . so i am asking for a vba formula so that 1 click is when finding or lookup will only take place.

 

[Misca]

I'd use a sub:

Sub GetLicences()

Dim c As Range
Dim Rng As Range


Set Rng = Sheets("Licences").Range("B:B")

For Each c In Selection
    With c
        If Application.WorksheetFunction.CountIf(Rng, .Value) > 0 Then    'makes sure a match is found
            .Offset(0, 9).Value = Rng.Find(.Value, Rng.Cells(1, 1)).Offset(0, 1).Value
        End If
    End With
Next c

End Sub

But since you wanted a function:

Function Licence(ESN As String) As String

Dim Rng As Range

Set Rng = Sheets("Licences").Range("B:B")

        If Application.WorksheetFunction.CountIf(Rng, ESN) > 0 Then    'makes sure a match is found
            Licence = Rng.Find(ESN, Rng.Cells(1, 1)).Offset(0, 1).Value
        Else
            Licence = "No Match"
        End If

End Function

 

[Stonesteel]

i tried to put the sub in a command button like this..

Private Sub CommandButton1_Click()
Call ip_address
End Sub
Private Sub CommandButton2_Click()
Call license_upgrade
End Sub
Private Sub CommandButton3_Click()
Call GetLicences
End Sub

and created a module with the sub given. but when I tried to click the command button, nothing happens, don't know what seems to be the problem. can you help me revise the code Misca? I really appreciate your help.

 

[Misca]

If your command buttons are placed on the sheet you can simply right click the button and attach the macro to it. Should work as it is as long as you have selected some ESNs for it to get the licences for.

From your code I get a feeling you have made a form and try to run the macros from the form, right? If that is the case the macro I wrote has a problem finding the selection to find the Licences for: When the form is active the code needs to be told the sheet references.

 

[Stonesteel]

nope, I am not using any form, i found the problem, it seems that in your code,

Dim Rng As Range


Set Rng = Sheets("Licences").Range("[COLOR=red]B:B[/COLOR]") 'replaced it with "[COLOR=red]A:A[/COLOR]"

For Each c In Selection

since we are offsetting, you are pinpointing to a column "B:B" where licenses are also located. I replaced it with range "A:A" where ESNs are located and it worked. Thank You Very Much Misca for your help, i really appreciate it... hope you could help me again soon,

 

[Stonesteel]

PS.

I'd like to put a message if no license was found, how should i put the code like this in your sub code?

Else
Licence = "No License"


thanks again.

 

[Misca]

Try:

Sub GetLicences2()

Dim c As Range
Dim Rng As Range
Dim Licence As String


Set Rng = Sheets("Licences").Range("A:A")

For Each c In Selection
    
    With c
        
        'Gets the Licence:
        If Application.WorksheetFunction.CountIf(Rng, .Value) > 0 Then    'makes sure a match is found
            Licence = Rng.Find(.Value, Rng.Cells(1, 1)).Offset(0, 1).Value
        Else
            Licence = "No Licence"
        End If
        
        .Offset(0, 9).Value = Licence   'Writes the Licence
        
    End With
Next c

End Sub

 

[Stonesteel]

Yey! it worked! You are such a very big help! now my work process may doubled or tripled. Thank you very much again for your help, i really really appreciate it Misca!