Code to bring up info if name is entered on a separate sheet

[kdlenort]

I want a code to run some type of a lookup which would bring up all the information, specific cells within the row of the name I type in to a sheet named "Search".<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Looking in several sheets named "??? Register" (the 3 question marks will be different letters or numbers on each Register sheet) starting in row 137.<o></o>
<o></o>
If the name does exist I want the information from each time the name is found, from columns B, C, D, E, G, H, & I to be listed on the Search sheet.<o></o>
If the name doesn't exist on the ??? Register sheets I would like a pop up to open and indicates "Name not found" or "Name doesn't exist".<o></o>
<o></o>
Is this possible??<?xml:namespace prefix = v ns = "urn:schemas-microsoft-com:vml" /><v:shapetype id=_x0000_t75 stroked="f" filled="f" path="m@4@5l@4@11@9@11@9@5xe" oreferrelative="t" o:spt="75" coordsize="21600,21600"> <v:stroke joinstyle="miter"></v:stroke><v:formulas><v:f eqn="if lineDrawn pixelLineWidth 0"></v:f><v:f eqn="sum @0 1 0"></v:f><v:f eqn="sum 0 0 @1"></v:f><v:f eqn="prod @2 1 2"></v:f><v:f eqn="prod @3 21600 pixelWidth"></v:f><v:f eqn="prod @3 21600 pixelHeight"></v:f><v:f eqn="sum @0 0 1"></v:f><v:f eqn="prod @6 1 2"></v:f><v:f eqn="prod @7 21600 pixelWidth"></v:f><v:f eqn="sum @8 21600 0"></v:f><v:f eqn="prod @7 21600 pixelHeight"></v:f><v:f eqn="sum @10 21600 0"></v:f></v:formulas><vath o:connecttype="rect" gradientshapeok="t" o:extrusionok="f"></vath><o:lock aspectratio="t" v:ext="edit"></o:lock></v:shapetype><o></o>

 

[kdlenort]

Here is the code as it is now
[Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$2" Then Exit Sub
Dim ws As Worksheet
Dim sh As Worksheet
Dim LR1 As Long
Dim LR2 As Long
Dim C As Range
Dim D As Range
Set sh = Sheets("Search")
Dim Flag As Boolean
Flag = False
Set D = sh.Range("$A$6:$H" & Cells(Rows.Count, "H").End(xlUp).Row + 1)
If Target = "" Then
D.ClearContents
Exit Sub
End If
D.ClearContents
For Each ws In Worksheets
If ws.Name = "SS" Then
LR1 = ws.Cells(Rows.Count, "F").End(xlUp).Row
With ws.Range("$F$2:$F" & LR1)
Set C = .Find(Target, LookIn:=xlValues)
If Not C Is Nothing Then
fstAdd = C.Address
Do
LR2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
ws.Cells(C.Row, 2).Resize(1, 4).Copy sh.Cells(LR2 + 1, "A")
ws.Cells(C.Row, 7).Resize(1, 3).Copy sh.Cells(LR2 + 1, 5)
sh.Cells(LR2 + 1, 8) = ws.Name
Set C = .FindNext(C)
Loop While Not C Is Nothing And fstAdd <> C.Address
Flag = True
End If
End With
End If
Next ws
If Flag = False Then MsgBox "Name Not Found"
End Sub]

I would like to change the Source sheet reference which appears in column H to be the value in column J on a sheet named SS.

Any help out there???

 

[lenze]

Will the name be on sheet "SS"?.

lenze

 

[kdlenort]

Hi lenze,

Yes, the name I want in the Source Sheet column on the Search sheet will be on the SS sheet in column J of the same row the other info is being pulled from.

 

[lenze]

AdShange this line

sh.Cells(LR2 + 1, 8) = ws.Name

to

If ws.Name = "SS" Then sh.Cells(C.Row,8) =ws.Cells(C.Row,10)

lenze

 

[kdlenort]

Good afternoon lenze

The code change is doing wacking things to the sheet now.

Do you want to look at it? It is hard to explain what is going on a lot easier seeing it first hand.

Thanks

 

[lenze]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$2" Then Exit Sub
Dim ws As Worksheet
Dim sh As Worksheet
Dim LR1 As Long
Dim LR2 As Long
Dim C As Range
Dim D As Range
Set sh = Sheets("Search")
Dim Flag As Boolean
Flag = False
Set D = sh.Range("$A$6:$H" & Cells(Rows.Count, "H").End(xlUp).Row + 1)
If Target = "" Then
    D.ClearContents
    Exit Sub
End If
D.ClearContents
With Sheets("SS").Range("F" & Cells(Rows.Count, "F").End(xlUp).Row)
    Set C = .Find(Target, LookIn:=xlValues)
    If Not C Is Nothing Then
       fstAdd = C.Address
       Do
       LR2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
       ws.Cells(C.Row, 2).Resize(1, 4).Copy sh.Cells(LR2 + 1, "A")
       ws.Cells(C.Row, 7).Resize(1, 3).Copy sh.Cells(LR2 + 1, 5)
       sh.Cells(C.Row, "I") = Sheets("SS").Cells(C.Row, "J")
       Set C = .FindNext(C)
       Loop While Not C Is Nothing And fstAdd <> C.Address
       Flag = True
    End If
End With
If Flag = False Then MsgBox "Name Not Found"
End Sub

lenze

 

[kdlenort]

Hi lenze,

With the new code "Name not found" comes up for everyname I try.

 

[kdlenort]

What if I move the names to Column A of the SS sheet, would that make the Search easier?

 

[lenze]

No, just a few glitches

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$2" Then Exit Sub
Dim ws1 As Worksheet
Dim sh As Worksheet
Dim LR1 As Long
Dim LR2 As Long
Dim C As Range
Dim D As Range
Set sh = Sheets("Search")
Set ws1 = Sheets("SS")
Dim Flag As Boolean
Flag = False
Set D = sh.Range("$A$6:$I" & Cells(Rows.Count, "I").End(xlUp).Row + 1)
If Target = "" Then
    D.ClearContents
    Exit Sub
End If
D.ClearContents
LR1 = ws1.Cells(Rows.Count, "F").End(xlUp).Row
MsgBox LR1
With ws1.Range("F2:F" & LR1)
    Set C = .Find(Target, LookIn:=xlValues)
    If Not C Is Nothing Then
       fstAdd = C.Address
       Do
       LR2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
       ws1.Cells(C.Row, 2).Resize(1, 4).Copy sh.Cells(LR2 + 1, "A")
       ws1.Cells(C.Row, 7).Resize(1, 3).Copy sh.Cells(LR2 + 1, 5)
       sh.Cells(LR2 + 1, "H") = ws1.Cells(C.Row, "J")
       Set C = .FindNext(C)
       Loop While Not C Is Nothing And fstAdd <> C.Address
       Flag = True
    End If
End With
If Flag = False Then MsgBox "Name Not Found"
End Sub

We're getting Close

lenze

 

[kdlenort]

Hi Lenze,

Sorry to be such a pain with this code but it is still not working.
Message box comes up with the last row entry number on the SS sheet then when I click ok and choose a name from the drop down list Name Not Found message box comes up for every name chosen.

Also when I clear the name in B2 it doesn't clear all the data just what is in the first row, row 6.