Search & copy function (macro)

[Closed]
Report
Posts
5
Registration date
Tuesday October 23, 2012
Status
Member
Last seen
October 25, 2012
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
Hello,
First of all, i will thank all who reads this question.

And such a good forum.

I have a question regarding a Macro.

Basically i have spreadsheet which is a small database.

Sheet1 is a database. Sheet1 keeps all data
Sheet2 is a inputsheet or form.

Sheet2:
A B C
1 Name Input Age Input weight
2 John
3 Peter

Ex. i am going to fill age and weight in B2 and C2.
So what i want a macro in input sheet. And macro has to copy to B2 & C2, than search for "John" in sheet1 and transfer data to sheet1 when it can mach "John" in sheet1. So it could copy to sheet1 at D5&E5.

Ex. Sheet1:
A B C D E
1 Name Adresse Sex Age weight
2 Christian north street male
3 Peter south street etc.
4 Tony etc. etc.
5 John etc etc.

Is it possible to do such macro. I hope u can understand my question.



Thanks in advance.




3 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
so how this match should occur . Should this be in a batch where as you would enter all names and other information and then run macro to have sheet1 updated or you have some thing else in mind
Posts
5
Registration date
Tuesday October 23, 2012
Status
Member
Last seen
October 25, 2012

Hello again.


Sheet2 will work as a input form.

Well i wil enter "John" in A1, age and weight in B2 and C2.

Sheet2:
A B C
1 Name Input Age Input weight
2 John


Than i want it to with help of macro to find "John" in Sheet1. And copy age and weight in sheet1 on same row, where John is already is mentioned.
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
and what if John is not listed then ?
Posts
5
Registration date
Tuesday October 23, 2012
Status
Member
Last seen
October 25, 2012

it will be delightfull with a standard error message, because jOhn is not listed.
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
I have my doubts about your requirement. However, based on what you said, try the macro below. Only thing that you need to be aware of is that, the active sheet must be your input sheet and active row must be the row for which you want to run update for

Option Explicit

Sub searchAndCopy()
    
    Dim activeRow           As Long
    Dim activeName          As String
    Dim matchRow            As Long
    Dim sourceSheet         As String
    Dim inputSheet          As String
    
    sourceSheet = "Sheet1"
    inputSheet = "Sheet2"
    
    activeRow = ActiveCell.Row
    activeName = Sheets(inputSheet).Cells(activeRow, "A")
    
    With Sheets(sourceSheet)
        matchRow = getItemLocation(activeName, .Columns(1))
        If (matchRow = 0) Then
            MsgBox "Error, unable to find name " + activeName, vbExclamation, "Error"
            Exit Sub
        End If
        .Cells(matchRow, "D") = Sheets(inputSheet).Cells(activeRow, "B")
        .Cells(matchRow, "E") = Sheets(inputSheet).Cells(activeRow, "C")
    End With
End Sub


Public Function getItemLocation(sLookFor As String, _
                                rngSearch As Range, _
                                Optional bFullString As Boolean = True, _
                                Optional bLastOccurance As Boolean = True, _
                                Optional bFindRow As Boolean = True) As Long
                                   
   'find the first/last row/column  within a range for a specific string
      
   Dim Cell             As Range
   Dim iLookAt          As Integer
   Dim iSearchDir       As Integer
   Dim iSearchOdr       As Integer
         
   If (bFullString) _
   Then
      iLookAt = xlWhole
   Else
      iLookAt = xlPart
   End If
   If (bLastOccurance) _
   Then
      iSearchDir = xlPrevious
   Else
      iSearchDir = xlNext
   End If
   If Not (bFindRow) _
   Then
      iSearchOdr = xlByColumns
   Else
      iSearchOdr = xlByRows
   End If
         
   With rngSearch
      If (bLastOccurance) _
      Then
         Set Cell = .Find(sLookFor, .Cells(1, 1), xlValues, iLookAt, iSearchOdr, iSearchDir)
      Else
         Set Cell = .Find(sLookFor, .Cells(.Rows.Count, .Columns.Count), xlValues, iLookAt, iSearchOdr, iSearchDir)
      End If
   End With
         
   If Cell Is Nothing Then
      getItemLocation = 0
   ElseIf Not (bFindRow) _
   Then
      getItemLocation = Cell.Column
   Else
      getItemLocation = Cell.Row
   End If
   Set Cell = Nothing

End Function
Posts
5
Registration date
Tuesday October 23, 2012
Status
Member
Last seen
October 25, 2012

Its working.... Perfect Thanks for ur professional assistance.

Its transfer the data as i want to.....

I have to questions... If it can't find the input, like the name is not mentioned already in database. I expect it with an error message, but it does not. Example "unable to find name" And the oposit, if transfer was ok, so a msg with "transfer done"

My 2nd question is, if my input sources are on C15toE15 instead of A2 to C2. Can you please highlight it in your awsome programming.

Thanks once again.
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
try to see this method. searchAndCopy. The other "getItemLocation" is just a helper
Posts
5
Registration date
Tuesday October 23, 2012
Status
Member
Last seen
October 25, 2012

Dear Rizvisa1,
I have tried to edit your macro, but i can suceed.
if my input sources in sheet2 are on C15toE15 instead of A2 to C2. What should i edit en your macro.

Sheet2:
C D E
14: Name Input Age Input weight
15: Jakob
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
It is trying to search in column 1
matchRow = getItemLocation(activeName, .Columns(1))
for the name

So when it finds a match, it get other stuff.