Need to Modify Existing Code

[Ryan Hess]

This is the 3rd post for this question but I don't think my other posts were
easy to follow or understand (I have a splitting headache and was rushing the
questions). I apologize for the repeated question. Hopefully I can clarify
here.

I use the following code.

''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Search1_Click()

Sheets("Sheet1").Unprotect Password:="qwerty"
Range("B17:L10000").Select
Selection.Delete Shift:=xlToLeft
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sAddr As String, s As Variant
Dim rng As Range, rng1 As Range
Set sh1 = Worksheets("Sheet1")
Set sh = Worksheets("Sheet2")
s = sh1.Range("E9")
Set rng = sh.Range(sh.Range("A3"), _
sh.Cells(Rows.Count, "B")).Find(What:=s, _
After:=sh.Cells(Rows.Count, 1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rng Is Nothing Then
sAddr = rng.Address
Do
If rng1 Is Nothing Then
Set rng1 = rng
Else
Set rng1 = Union(rng1, rng)
End If
Set rng = sh.Range(sh.Range("B3"), _
sh.Cells(Rows.Count, 1)).FindNext(rng)
Loop Until rng.Address = sAddr
If Not rng1 Is Nothing Then
Set rng1 = Intersect(rng1.EntireRow, sh.Range("B:L"))
rng1.Copy sh1.Range("B17")
End If
End If
Sheets("Sheet1").Select
Range("E9").Select
Selection.ClearContents
Sheets("Sheet1").Protect Password:="qwerty"

End Sub
''''''''''''''''''''''''''''''''''''''''''''''

After I enter a value on sheet1 E9 and initiate the macro, it firsts clears
the designated area on Sheet1 then it searchs Sheet2 for that value. When
that Value (from E9) is found it copies the row and pastes it on Sheet1 in
the designated area. If there is no value on Sheet2 that matches the value
in E9 then it doesn't copy/paste anything in the designated area on Sheet1.

What I want to modify:::

A) Value E9 is found -- Instead of copy/pasting the row to the designated
area I want to pick and choose which values in that row to copy and paste
them in designated locations using this code;

''''''''''''''''''''''''''
Sheets("Sheet1").Range("D14").Value = Sheets("Sheet2").Range("B*").Value
Sheets("Sheet1").Range("D15").Value = Sheets("Sheet2").Range("C*").Value
Sheets("Sheet1").Range("D13").Value = Sheets("Sheet2").Range("E*").Value
Sheets("Sheet1").Range("H18").Value = Sheets("Sheet2").Range("G*").Value
Sheets("Sheet1").Range("H19").Value = Sheets("Sheet2").Range("H*").Value
Sheets("Sheet1").Range("H20").Value = Sheets("Sheet2").Range("I*").Value
Sheets("Sheet1").Range("H21").Value = Sheets("Sheet2").Range("J*").Value
Sheets("Sheet1").Range("H22").Value = Sheets("Sheet2").Range("K*").Value
Sheets("Sheet1").Range("H23").Value = Sheets("Sheet2").Range("L*").Value

* = the row in which the ID number you searched is located.
''''''''''''''''''''''''''

B) Value E9 is not found -- Instead of not copy/pasting anthing and just
ending the macro, I would like it to produce the following;

'''''''''''''''''''''''''''''
MsgBox "Value not found."
'''''''''''''''''''''''''''''

I hope that is easier to understand what I'm trying to figure out. Again, I
apologize for the earlier posts and thank you for any help you are able to
share.

Thank you!

 

[Tom Ogilvy]

Private Sub Search1_Click()

Sheets("Sheet1").Unprotect Password:="qwerty"
Range("B17:L10000").Select
Selection.Delete Shift:=xlToLeft
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sAddr As String, s As Variant
Dim rng As Range, rng1 As Range
Set sh1 = Worksheets("Sheet1")
Set sh = Worksheets("Sheet2")
s = sh1.Range("E9")
Set rng = sh.Range(sh.Range("A3"), _
sh.Cells(Rows.Count, "B")).Find(What:=s, _
After:=sh.Cells(Rows.Count, 1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rng Is Nothing Then
sh1.Range("D14").Value = sh.Range("B" & rng.row).Value
sh1.Range("D15").Value = sh.Range("C" & rng.row).Value
sh1.Range("D13").Value = sh.Range("E" & rng.row).Value
sh1.Range("H18").Value = sh.Range("G" & rng.row).Value
sh1.Range("H19").Value = sh.Range("H" & rng.row).Value
sh1.Range("H20").Value = sh.Range("I" & rng.row).Value
sh1.Range("H21").Value = sh.Range("J" & rng.row).Value
sh1.Range("H22").Value = sh.Range("K" & rng.row).Value
sh1.Range("H23").Value = sh.Range("L" & rng.row).Value
Else
MsgBox "Value not found."

End If

Sheets("Sheet1").Select
Range("E9").Select
Selection.ClearContents
Sheets("Sheet1").Protect Password:="qwerty"

End Sub

 

[Ryan Hess]

That worked great Tom. One last question. How do I change it so that if I
don't enter any value in E9 that it gives me the MsgBox "Value not found" and
exits the sub like it does when the value in E9 doesn't exist.??

Thank you very much!

 

[Tom Ogilvy]

Private Sub Search1_Click()

if len(trim(Worksheets("Sheet1").Range("B9").Value)) = 0 then
msgbox "Value not found"
exit sub
End if

Sheets("Sheet1").Unprotect Password:="qwerty"
Range("B17:L10000").Select
Selection.Delete Shift:=xlToLeft
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sAddr As String, s As Variant
Dim rng As Range, rng1 As Range
Set sh1 = Worksheets("Sheet1")
Set sh = Worksheets("Sheet2")
s = sh1.Range("E9")
Set rng = sh.Range(sh.Range("A3"), _
sh.Cells(Rows.Count, "B")).Find(What:=s, _
After:=sh.Cells(Rows.Count, 1), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rng Is Nothing Then
sh1.Range("D14").Value = sh.Range("B" & rng.row).Value
sh1.Range("D15").Value = sh.Range("C" & rng.row).Value
sh1.Range("D13").Value = sh.Range("E" & rng.row).Value
sh1.Range("H18").Value = sh.Range("G" & rng.row).Value
sh1.Range("H19").Value = sh.Range("H" & rng.row).Value
sh1.Range("H20").Value = sh.Range("I" & rng.row).Value
sh1.Range("H21").Value = sh.Range("J" & rng.row).Value
sh1.Range("H22").Value = sh.Range("K" & rng.row).Value
sh1.Range("H23").Value = sh.Range("L" & rng.row).Value
Else
MsgBox "Value not found."

End If

Sheets("Sheet1").Select
Range("E9").Select
Selection.ClearContents
Sheets("Sheet1").Protect Password:="qwerty"

End Sub