Simple V Lookup Macro to paste data

C

Celticfc

Board Regular
Joined
Feb 28, 2016
Messages
153
Hi all,

I want to make a simple database - I already have a list of User ID's in Column A.

I would like clients to enter their User ID in F1, DOB in G1 and Location in H1.

I would like to add a macro button where once clicked, it should look for the User ID and paste DOB and Location in to columns B and C.

I would really appreciate any support. Many thanks in advance.
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
Hi there Celticfc.

I have modified a code I found on Ron de Bruins page for your purposes.

here is the code you require. I would also suggest that you set up data validation as a list in cell F1 with the source as all your IDs or =$A:$A to prevent any issues

Code: 
Sub Add_Info()
    Dim FindString As String
    Dim Rng As Range
    FindString = Range("F1").Value
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                ActiveCell.Offset(0, 1).Value = Range("G1").Value
                ActiveCell.Offset(0, 2).Value = Range("H1").Value
                Range("F1:H1").ClearContents
                Application.Goto Range("A1"), True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub





Another way you could do this is with a slight alteration to the code:
This does away with the need for cells G1 and H1, the user simply selects their ID from the data validation drop down, presses the button and enters their info in the two input boxes that appear. I think this is slightly more end user friendly.

Code: 
Sub Add_Info()
    Dim FindString As String
    Dim Rng As Range
    FindString = Range("F1").Value
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                ActiveCell.Offset(0, 1).Value = InputBox("Enter your DOB", "DOB", "dd/mm/yyyy")
                ActiveCell.Offset(0, 2).Value = InputBox("Enter your location", "Location")
                Range("F1").ClearContents
                Application.Goto Range("A1"), True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub
 
Last edited:
Upvote 0
cooper645 said:
Hi there Celticfc.

I have modified a code I found on Ron de Bruins page for your purposes.

here is the code you require. I would also suggest that you set up data validation as a list in cell F1 with the source as all your IDs or =$A:$A to prevent any issues

Code: 
Sub Add_Info()
    Dim FindString As String
    Dim Rng As Range
    FindString = Range("F1").Value
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                ActiveCell.Offset(0, 1).Value = Range("G1").Value
                ActiveCell.Offset(0, 2).Value = Range("H1").Value
                Range("F1:H1").ClearContents
                Application.Goto Range("A1"), True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub





Another way you could do this is with a slight alteration to the code:
This does away with the need for cells G1 and H1, the user simply selects their ID from the data validation drop down, presses the button and enters their info in the two input boxes that appear. I think this is slightly more end user friendly.

Code: 
Sub Add_Info()
    Dim FindString As String
    Dim Rng As Range
    FindString = Range("F1").Value
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.Goto Rng, True
                ActiveCell.Offset(0, 1).Value = InputBox("Enter your DOB", "DOB", "dd/mm/yyyy")
                ActiveCell.Offset(0, 2).Value = InputBox("Enter your location", "Location")
                Range("F1").ClearContents
                Application.Goto Range("A1"), True
            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
End Sub
Click to expand...

Hi
Cooper645,



Thank you for your time.



I have added this to my submit button but I'm getting an expected end sub
error, this is what I have:





Code: 
Private Sub CommandButton1_Click()

Sub Add_Info()

    Dim FindString As String

    Dim Rng As Range

    FindString = Range("F1").Value

    If Trim(FindString) <> "" Then

        With Sheets("Sheet1").Range("A:A")

            Set Rng =
.Find(What:=FindString, _

                           
After:=.Cells(.Cells.Count), _

                           
LookIn:=xlValues, _

                           
LookAt:=xlWhole, _

                           
SearchOrder:=xlByRows, _

                           
SearchDirection:=xlNext, _

                           
MatchCase:=False)

            If Not Rng
Is Nothing Then

               
Application.Goto Rng, True

               
ActiveCell.Offset(0, 1).Value = Range("G1").Value

               
ActiveCell.Offset(0, 2).Value = Range("H1").Value

               
Range("F1:H1").ClearContents

               
Application.Goto Range("A1"), True

            Else

               
MsgBox "Nothing found"

            End If

        End With

    End If

End Sub

End Sub



Also, once I get this code to work, how can I change the columns from G-H to AY & AZ? Thank you again.

p.s. Subscript out of range error
 
Last edited:
Upvote 0
This is how it should read, you had a sub in sub thing going on.

To change G & H simply change the range references. Don’t forget to amend the clear contents range.
 
Last edited:
Upvote 0
Private Sub CommandButton1_Click()

Dim FindString As String
Dim Rng As Range
FindString = Range("F1").Value
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("A:A")
Set Rng =
.Find(What:=FindString, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)

If Not Rng
Is Nothing Then

Application.Goto Rng, True

ActiveCell.Offset(0, 1).Value = Range("G1").Value

ActiveCell.Offset(0, 2).Value = Range("H1").Value

Range("F1:H1").ClearContents

Application.Goto Range("A1"), True

Else

MsgBox "Nothing found"

End If

End With

End If

End Sub
 
Upvote 0
Thank you very much.

I have used a user form with text box and planning to extend my work.

Just one question:

1)When I run the above code, it goes to sheet1 to do the changes, is there a way to stay on the entry page with everything getting done in the back ground?
 
Upvote 0
What is the sheet name that the DOB and LOCATION need to be made on?
Also where would you like to finish up after the code has run? IE which sheet and cell.

If if you let me know I’ll amend the code to suit and highlight the changes to help you figure the code out.
 
Upvote 0
If you post your code as you have it working at the moment and also let me know where the changes need to happen and where the code needs to finish, I will sort it for you.
 
Upvote 0
cooper645 said:
If you post your code as you have it working at the moment and also let me know where the changes need to happen and where the code needs to finish, I will sort it for you.
Click to expand...

Hi Cooper,

I have developed the code further,

I need a code where if I haven't highlighted a combo or textbox within by userform, I don't want to paste it's data back to my database as it takes long time and it's unnessary.

For example, with the current code, if a client just enters or updates 1 box, all 23 boxes get pasted again even though they haven't been changed.

I would appreciate your help, many thanks.
Code: 
Private Sub Submitbutton_Click()
    Dim FindString As String
    Dim Rng As Range
    FindString = Range("e11").Value
    If Trim(FindString) <> "" Then
        With Sheets("manager 1").Range("f:f")
            Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Application.ScreenUpdating = False
                Application.Goto Rng, False
                ActiveCell.Offset(0, 0).Value = TextBox26.Value 'name
                ActiveCell.Offset(0, -5).Value = ComboBox19.Value 'store
                ActiveCell.Offset(0, -1).Value = TextBox24.Value 'position
                ActiveCell.Offset(0, 1).Value = TextBox23.Value 'hire date
                ActiveCell.Offset(0, 2).Value = TextBox22.Value 'current role start date
                ActiveCell.Offset(0, 3).Value = TextBox21.Value 'function start date
                ActiveCell.Offset(0, 4).Value = TextBox36.Value 'status
                ActiveCell.Offset(0, 5).Value = TextBox46.Value 'status start date
                ActiveCell.Offset(0, 6).Value = TextBox56.Value 'salary
                ActiveCell.Offset(0, 7).Value = TextBox66.Value 'review grade
                ActiveCell.Offset(0, 9).Value = TextBox76.Value 'ly review grade
                ActiveCell.Offset(0, 8).Value = TextBox86.Value 'potential scope
                ActiveCell.Offset(0, 10).Value = TextBox96.Value 'ly potential scope
                ActiveCell.Offset(0, 11).Value = TextBox12.Value 
                ActiveCell.Offset(0, 12).Value = TextBox13.Value 
                ActiveCell.Offset(0, 13).Value = TextBox14.Value 
                ActiveCell.Offset(0, 14).Value = TextBox15.Value 'mother tongue
                ActiveCell.Offset(0, 15).Value = TextBox16.Value 'additional lang 1
                ActiveCell.Offset(0, 16).Value = TextBox18.Value 'additional lang 2
                ActiveCell.Offset(0, 17).Value = TextBox19.Value 'additional lang 3
                ActiveCell.Offset(0, 18).Value = TextBox20.Value 'secondment
                ActiveCell.Offset(0, 19).Value = TextBox31.Value 'length of secondment
                ActiveCell.Offset(0, 20).Value = TextBox32.Value 'relocation 1
                ActiveCell.Offset(0, 21).Value = TextBox33.Value 'relocation 2
                ActiveCell.Offset(0, 22).Value = TextBox43.Value 
                ActiveCell.Offset(0, 23).Value = TextBox54.Value 
                Sheets("One-Pager Profile").Select
                Range("A1").Select
                Unload Me
                'MsgBox "Comment Saved"
                            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
     
   
End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
Macro to correct entries across multiple sheets
Replies
1
Views
210
Lux Aeterna
L
W
  • Solved
vba/macro to Find a line on another sheet and replace information in just 1 cell in that line
Replies
5
Views
95
mumps
mumps
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
1K
Micron
M
B
  • Question Question
Update Variable Data from Multiple Worksheets in a Master Sheet
2
Replies
11
Views
779
mumps
mumps
R
  • Question Question
I need to return a lookup on a table once a slicer has been selected.
Replies
3
Views
535
JamesCanale
JamesCanale

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top