Search Value If Found transfer Data in same row to specified locat

[Ryan Hess]

I'm not sure that is what I'm looking for. Perhaps I didnt explain what I'm
trying to do well enough though. Let me try and explain more.

To simplify a little I'll just use default names for the sheets rather than
what I renamed them.

So I have; Sheet1, Sheet2, Sheet3

Sheet1 -- I enter an ID number in cell E4 that I want to look up.
(A macro button is on Sheet1 to initiate the search)

Sheet2 -- Is where all my values are stored for lets say 11 different
paramaters.
Column B is a list of all the ID numbers. Columns C - L is a
list of all the
other paramaters that coincide with ID number in their
respected row.

Sheet3 -- Is a form used to print out for specific ID numbers using Sheet1
to define
which ID number is used and Sheet2 to provide the 4 data
values that are
designated to that same ID number that was chosen.

1) Enter in the desired ID number. (Sheet1 cell E4)
2) Click on the macro button. (Sheet1)
3) Sub
4) Find the ID numbered entered above on Sheet2 ColumnB
4a) If the ID number is found (recognizing the row) transfer the data
in Columns B - L to specific locations on Sheet3 (**** see the code
at the bottom of page as I do not want to just copy the row and
paste it over)
4b) If the ID number is not found, MsgBox "ID number not found"
5) End If End Sub


I do have this code which allows me to search the ID number and then
copy/paste the row on a new sheet but like I said, I want to take only
certain cells in the row and "Copy/Paste" them to specific cells on Sheet3.

Private Sub Search1_Click()

Sheets("Search").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("Search")
Set sh = Worksheets("Database")
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("Search").Select
Range("E9").Select
Selection.ClearContents
Sheets("Search").Protect Password:="qwerty"
'ActiveWorkbook.Save

End Sub

Note: I just cut paste the code as it is in my button macro. So ignore the
little extras I added to the "Search/Cut-Paste" portion.


Click to show or hide original message or reply text.

 

[JLGWhiz]

OK, Ryan. It finally penetrated this old skull. I
think that what you need is an algorithm that will
test for the column where the ID number is found in
sheet 2 and once you do the copy it runs the algorithm
similar to this example:

If Left(RngToCopy, 1) = "B" Then
Wks3.Range("D14").PasteSpecial Paste:=xlValues
ElseIf Left(RngToCopy, 1) = "C" Then
Wks.Range("D15").PasteSpecial Paste:=xlValues
ElseIf Left(RngToCopy, 1) = "D" Then
Wks3.Range("D13").PasteSpecial Paste:=xlValues
....etc. for all of the cells on your form.

This is only an example, you will need to build the
algorithm to suit you form requirements.

You would need to put this in a loop so that each Id
number is evaluated in the algorithm.

There might be a simpler way to do it, but right now I
can't think of it.

By the way, The left function I used above might need
to be tweaked to compensate for the $ character in
the address. What you are looking for is the column
that the address is in. Good luck.