Search a different Column depending on Outcome

[Yugo101]

This may be bit complicated to explain as can't use the work in question as its to do with my job.

Here is my problem.

Two spreadsheets -
1 - Gathering sheet (Column B - Username, C - E-mail- D - Name)
2 - Database sheet (Contains Usernames B, E-mails C, Address etc D, Name - E Look up spreadsheet)

On the Gathering sheet I have 4 columns B-D. Currently how my sheet works if I enter a persons username in B2 this then will populate C-D details by using look up (Database sheet). If username is unknown but e-mail is known I can enter the email in Column C which then populates B&D (circular reference). For me this works fine but want I want to do is create a extra column (Column A) where they can enter either username/e-mail and then that will populate B-D columns then "Not found" if no data is not found. Is this possible?.

I use a combination of Vlookup and Xlookup currently. I am thinking it may require multiple IF functions.

Any help will be great.

 

[mumps]

If you are interested in using VBA, copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your "Gathering " sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter an email address or username in column A and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    Dim email As Range, username As Range
    Application.ScreenUpdating = False
    If InStr(Target, "@") > 0 Then
        Set email = Sheets("Database").Range("C:C").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not email Is Nothing Then
            Range("B" & Target.Row).Resize(, 3) = Array(email.Offset(, -1), Target.Value, email.Offset(, 2))
        Else
            MsgBox (email & " not found.")
            Exit Sub
        End If
    Else
        Set username = Sheets("Database").Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not username Is Nothing Then
            Range("B" & Target.Row).Resize(, 3) = Array(Target.Value, username.Offset(, 1), username.Offset(, 3))
        Else
            MsgBox (username & " not found.")
        End If
    End If
    Application.ScreenUpdating = False
End Sub

 

[Yugo101]

If you are interested in using VBA, copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your "Gathering " sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter an email address or username in column A and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    Dim email As Range, username As Range
    Application.ScreenUpdating = False
    If InStr(Target, "@") > 0 Then
        Set email = Sheets("Database").Range("C:C").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not email Is Nothing Then
            Range("B" & Target.Row).Resize(, 3) = Array(email.Offset(, -1), Target.Value, email.Offset(, 2))
        Else
            MsgBox (email & " not found.")
            Exit Sub
        End If
    Else
        Set username = Sheets("Database").Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not username Is Nothing Then
            Range("B" & Target.Row).Resize(, 3) = Array(Target.Value, username.Offset(, 1), username.Offset(, 3))
        Else
            MsgBox (username & " not found.")
        End If
    End If
    Application.ScreenUpdating = False
End Sub

I tried it on a dummy file and looks to work amazingly. Something I should of mentioned, the Database isn't a sheet its another workbook (workbook (Database), Sheet (Report), how would implement that file path into the code?. Also I'm getting a error for MsgBox (username & " not found.") when put unknown entry in

 

[mumps]

Make sure that the Database workbook is open as well as the "Gathering" workbook and then try this version of the macro. Change the workbook name (in red) and the sheet name (in blue) to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    Dim email As Range, username As Range, srcWS As Worksheet
    Set srcWS = Workbooks("[COLOR=rgb(226, 80, 65)][B]Database.xlsx[/B][/COLOR]").Sheets("[COLOR=rgb(41, 105, 176)][B]Report[/B][/COLOR]")
    Application.ScreenUpdating = False
    If InStr(Target, "@") > 0 Then
        Set email = srcWS.Range("C:C").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not email Is Nothing Then
            Range("B" & Target.Row).Resize(, 3) = Array(email.Offset(, -1), Target.Value, email.Offset(, 2))
        Else
            MsgBox (email & " not found.")
            Exit Sub
        End If
    Else
        Set username = srcWS.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not username Is Nothing Then
            Range("B" & Target.Row).Resize(, 3) = Array(Target.Value, username.Offset(, 1), username.Offset(, 3))
        Else
            MsgBox (username & " not found.")
        End If
    End If
    Application.ScreenUpdating = False
End Sub

I'm getting a error for MsgBox (username & " not found.") when put unknown entry in

The message boxes serve to warn you if you enter an invalid email or username. If you don't want this to happen, please let me know and I will modify the macro.

 

[Yugo101]

Make sure that the Database workbook is open as well as the "Gathering" workbook and then try this version of the macro. Change the workbook name (in red) and the sheet name (in blue) to suit your needs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    Dim email As Range, username As Range, srcWS As Worksheet
    Set srcWS = Workbooks("[COLOR=rgb(226, 80, 65)][B]Database.xlsx[/B][/COLOR]").Sheets("[COLOR=rgb(41, 105, 176)][B]Report[/B][/COLOR]")
    Application.ScreenUpdating = False
    If InStr(Target, "@") > 0 Then
        Set email = srcWS.Range("C:C").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not email Is Nothing Then
            Range("B" & Target.Row).Resize(, 3) = Array(email.Offset(, -1), Target.Value, email.Offset(, 2))
        Else
            MsgBox (email & " not found.")
            Exit Sub
        End If
    Else
        Set username = srcWS.Range("B:B").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not username Is Nothing Then
            Range("B" & Target.Row).Resize(, 3) = Array(Target.Value, username.Offset(, 1), username.Offset(, 3))
        Else
            MsgBox (username & " not found.")
        End If
    End If
    Application.ScreenUpdating = False
End Sub

The message boxes serve to warn you if you enter an invalid email or username. If you don't want this to happen, please let me know and I will modify the macro.

I got the msg to work just removed the email and username bit. So does the database have to be open at all times. Reason is there is quite a lot of people using the spreadsheet so the database workbook will never be open

 

[mumps]

The macro can open it for the user, copy the data and then close the file. If you want to use this approach, I would need to know the full path to the folder where the Database file is saved.