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.
 
Sort by date Sort by votes
You could try the following amended code. Orange depicts the main changes/additions. The only other thing I did was clean it a little by using the With/End with to remove all the ActiveCell references.

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
[COLOR=#ffa500]            With Application[/COLOR]
[COLOR=#ffa500]                .ScreenUpdating = False[/COLOR]
[COLOR=#ffa500]                .EnableEvents = False[/COLOR]
[COLOR=#ffa500]                .Calculation = xlCalculationManual[/COLOR]
[COLOR=#ffa500]                .Goto Rng, False[/COLOR]
[COLOR=#ffa500]            End With[/COLOR]
                    With ActiveCell
                        .Offset(0, 0).Value = TextBox26.Value 'name
                        .Offset(0, -5).Value = ComboBox19.Value 'store
                        .Offset(0, -1).Value = TextBox24.Value 'position
                        .Offset(0, 1).Value = TextBox23.Value 'hire date
                        .Offset(0, 2).Value = TextBox22.Value 'current role start date
                        .Offset(0, 3).Value = TextBox21.Value 'function start date
                        .Offset(0, 4).Value = TextBox36.Value 'status
                        .Offset(0, 5).Value = TextBox46.Value 'status start date
                        .Offset(0, 6).Value = TextBox56.Value 'salary
                        .Offset(0, 7).Value = TextBox66.Value 'review grade
                        .Offset(0, 9).Value = TextBox76.Value 'ly review grade
                        .Offset(0, 8).Value = TextBox86.Value 'potential scope
                        .Offset(0, 10).Value = TextBox96.Value 'ly potential scope
                        .Offset(0, 11).Value = TextBox12.Value
                        .Offset(0, 12).Value = TextBox13.Value
                        .Offset(0, 13).Value = TextBox14.Value
                        .Offset(0, 14).Value = TextBox15.Value 'mother tongue
                        .Offset(0, 15).Value = TextBox16.Value 'additional lang 1
                        .Offset(0, 16).Value = TextBox18.Value 'additional lang 2
                        .Offset(0, 17).Value = TextBox19.Value 'additional lang 3
                        .Offset(0, 18).Value = TextBox20.Value 'secondment
                        .Offset(0, 19).Value = TextBox31.Value 'length of secondment
                        .Offset(0, 20).Value = TextBox32.Value 'relocation 1
                        .Offset(0, 21).Value = TextBox33.Value 'relocation 2
                        .Offset(0, 22).Value = TextBox43.Value
                        .Offset(0, 23).Value = TextBox54.Value
                    End With
                Sheets("One-Pager Profile").Select
                Range("A1").Select
                Unload Me
                    [COLOR=#ffa500]With Application
                        .ScreenUpdating = True
                        .EnableEvents = True
                        .Calculation = xlCalculationAutomatic
                    End With[/COLOR]
                'MsgBox "Comment Saved"
                            Else
                MsgBox "Nothing found"
            End If
        End With
    End If
     
End Sub
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Hi Cooper,
I’ve tried and it takes about 30 seconds to update vs. 45 seconds with original code.

Is there anything else we can do?

Also, how does the above code check if a box has been changed and only update corresponding value? Thank you.
 
Upvote 0
What I realised is,

If I add only 1 textbox, and remove rest of offsets, it takes 7 seconds.

So it takes 7 seconds to change one box.

If I have 23 offsets, and only change 1 box, it takes 30 seconds, therefore, it still checks all boxes if there’s been a change.

Ideally we would want it to jump and only update cells with corresponding changed boxes. If a box hasn’t been changed, it should ignore it altogether without checking if it needs updating.
 
Upvote 0
what is the code for you user form initialize? the speed could be down to that?
 
Upvote 0
Hi Cooper,
Below is the code I'm using, thank you.
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
            With Application
                .ScreenUpdating = False
                .EnableEvents = False
                .Calculation = xlCalculationManual
                .Goto Rng, False
            'End With
                    With ActiveCell
                        .Offset(0, 0).Value = TextBox26.Value 'name
                        .Offset(0, -5).Value = ComboBox19.Value 'store
                        .Offset(0, -1).Value = ComboBox2.Value 'position
                        .Offset(0, 1).Value = TextBox4.Value 'hire date
                        .Offset(0, 2).Value = TextBox7.Value 'current role start date
                        .Offset(0, 3).Value = TextBox15.Value 'function start date
                        .Offset(0, 4).Value = ComboBox3.Value 'status
                        .Offset(0, 5).Value = TextBox9.Value 'status start date
                        .Offset(0, 6).Value = TextBox10.Value 'salary
                        .Offset(0, 7).Value = ComboBox4.Value 'review grade
                        .Offset(0, 9).Value = ComboBox5.Value 'ly review grade
                        .Offset(0, 8).Value = ComboBox6.Value 'potential scope
                        .Offset(0, 10).Value = ComboBox7.Value 'ly potential scope
                        .Offset(0, 11).Value = ComboBox8.Value 'learning offer adp/mdp
                        .Offset(0, 12).Value = ComboBox9.Value 'learing offer %
                        .Offset(0, 13).Value = TextBox22.Value 'learning offer sign off date
                        .Offset(0, 14).Value = TextBox21.Value 'mother tongue
                        .Offset(0, 15).Value = ComboBox10.Value 'additional lang 1
                        .Offset(0, 16).Value = ComboBox11.Value 'additional lang 2
                        .Offset(0, 17).Value = ComboBox12.Value 'additional lang 3
                        .Offset(0, 18).Value = ComboBox13.Value 'secondment
                        .Offset(0, 19).Value = ComboBox14.Value 'length of secodment
                        .Offset(0, 20).Value = ComboBox15.Value 'relocation 1
                        .Offset(0, 21).Value = ComboBox16.Value 'relocation 2
                        .Offset(0, 22).Value = ComboBox17.Value 'learning offer courses
                        .Offset(0, 23).Value = ComboBox18.Value 'rdf courses
                        Sheets("One-Pager Profile").Select
                        Range("A1").Select
                        Unload Me
                        End With
                'With Application
                   .ScreenUpdating = True
                   .EnableEvents = True
                   .Calculation = xlCalculationAutomatic
                         'MsgBox "Please update salary or position in the Manager Profile tab Comment Saved"
                    'Else
                End With
                MsgBox "Nothing found"
            End If
        'End With
    End With
     End If
End Sub
 
Upvote 0
Just brain storming,

Before pasting data,

Can we not add a criteria where, if Textbox.value IS SAME AS cell.value, then skip, if not the same, then paste it? And repeat this for all boxes?

This way, it won’t update all the cells that have same value as textbox contents?
 
Last edited:
Upvote 0
I believe that would add more steps overall, as it. checks each first and then writes some, rather than just write all of them.

What is the code you are using to load and fill in your userform? The code above is just what happens when you press the submit button on your form.

There may be events firing unnecessarily on your Initialize.

Coops,
 
Upvote 0
Hi Cooper,

My database is connected to about 30 tabs, which all have formulations. Therefore, when we update anything on the database, every page updates/recalculates, this is what is causing the waiting time I believe. If, however, we can avoid pasting same data, then waiting time naturally will be lower.

Sorry forgot to mention, when I load the user form, I call a module where boxes get filled by corresponding ranges in the database. This works smoothly with a click of a button, the reading part. It's the writing that takes up all the time even though when I only change a single box.

The code is below:
Code: 
Sub ViewManager1()
userform2.TextBox26.Text = CStr(Range("f2").Value) 'name
userform2.ComboBox19.Text = CStr(Range("a2").Value) 'store
userform2.TextBox24.Text = CStr(Range("b2").Value) 'district
userform2.TextBox25.Text = CStr(Range("c2").Value) 'region
userform2.TextBox5.Text = CStr(Range("d2").Value) 'country
userform2.ComboBox2.Text = CStr(Range("e2").Value) 'position
userform2.TextBox4.Text = CStr(Range("g2").Value) 'hire date
userform2.TextBox7.Text = CStr(Range("h2").Value) 'current role start date
userform2.TextBox15.Text = CStr(Range("i2").Value) 'function start date
userform2.ComboBox3.Text = CStr(Range("j2").Value) 'status
userform2.TextBox9.Text = CStr(Range("k2").Value) 'status start date
userform2.TextBox10.Text = CStr(Format(Range("l2").Value, "£#,##0")) 'salary
userform2.ComboBox4.Text = CStr(Range("m2").Value) 'review grade
userform2.ComboBox5.Text = CStr(Range("o2").Value) 'last year review grade
userform2.ComboBox6.Text = CStr(Range("n2").Value) 'potential scope
userform2.ComboBox7.Text = CStr(Range("p2").Value) 'ly potential scope
userform2.ComboBox8.Text = CStr(Range("q2").Value) 'learning offer ADp/MDP
userform2.ComboBox9.Text = CStr(Format(Range("r2").Value, "#0%")) 'learning offer %
userform2.TextBox22.Text = CStr(Range("s2").Value) 'learning offer sign off date
userform2.TextBox21.Text = CStr(Range("t2").Value) 'mother tongue
userform2.ComboBox10.Text = CStr(Range("u2").Value) 'addtional language 1
userform2.ComboBox11.Text = CStr(Range("v2").Value) 'addtional language 2
userform2.ComboBox12.Text = CStr(Range("w2").Value) 'addtional language 3
userform2.ComboBox13.Text = CStr(Range("x2").Value) 'willing to secondment
userform2.ComboBox14.Text = CStr(Range("y2").Value) 'length of secondment
userform2.ComboBox15.Text = CStr(Range("z2").Value) 'relocation 1
userform2.ComboBox16.Text = CStr(Range("aa2").Value) 'relocation 2
userform2.ComboBox17.Text = CStr(Range("ab2").Value) 'learning offer courses attended
userform2.ComboBox18.Text = CStr(Range("ac2").Value) 'RDF courses attended
'userform2.Show
End Sub
 
Upvote 0
...and below is the latest code, it's now down to about 20 secs... getting there (=

Code: 
Private Sub Submitbutton_Click()
    Dim FindString As String
    Dim Rng As Range
    
    
    FindString = Range("e11").Value
    
    If Trim(FindString) = "" Then Exit Sub
    
'manage errors
    On Error GoTo ExitSub
    
'search range
        Set Rng = Sheets("manager 1").Columns(6).Find(What:=FindString, LookIn:=xlValues, _
                                                        LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                                        SearchDirection:=xlNext, MatchCase:=False)
        If Not Rng Is Nothing Then
'turn events off
            With Application
                .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual
            End With
'add data to worksheet
            
                       If Rng.Offset(0, 0).Value = TextBox26.Value Then
                       Else
                       Rng.Offset(0, 0).Value = TextBox26.Value
                       End If
                       If Rng.Offset(0, -5).Value = ComboBox19.Value Then
                       Else
                       Rng.Offset(0, -5).Value = ComboBox19.Value
                       End If
                       If Rng.Offset(0, -1).Value = ComboBox2.Value Then
                       Else
                       Rng.Offset(0, -1).Value = ComboBox2.Value
                       End If
                       'position
                        If Rng.Offset(0, 1).Value = TextBox4.Value Then
                        Else
                        Rng.Offset(0, 1).Value = TextBox4.Value
                        End If
                        'hire date
                        If Rng.Offset(0, 2).Value = TextBox7.Value Then
                        Else
                        Rng.Offset(0, 2).Value = TextBox7.Value
                        End If
                        'current role start date
                        If Rng.Offset(0, 3).Value = TextBox15.Value Then
                        Else
                        Rng.Offset(0, 3).Value = TextBox15.Value
                        End If 'function start date
                        If Rng.Offset(0, 4).Value = ComboBox3.Value Then
                        Else
                        Rng.Offset(0, 4).Value = ComboBox3.Value
                        End If
                        'status
                        If Rng.Offset(0, 5).Value = TextBox9.Value Then
                        Else
                        Rng.Offset(0, 5).Value = TextBox9.Value
                        End If
                        'status start date
                        If Rng.Offset(0, 6).Value = TextBox10.Value Then
                        Else
                        Rng.Offset(0, 6).Value = TextBox10.Value
                        End If
                        'salary
                        If Rng.Offset(0, 7).Value = ComboBox4.Value Then
                        Else
                        Rng.Offset(0, 7).Value = ComboBox4.Value
                        End If
                        
                        'review grade
                        If Rng.Offset(0, 9).Value = ComboBox5.Value Then
                        Else
                        Rng.Offset(0, 9).Value = ComboBox5.Value
                        End If
                        'ly review grade
                        If Rng.Offset(0, 8).Value = ComboBox6.Value Then
                        Else
                        Rng.Offset(0, 8).Value = ComboBox6.Value
                        End If
                        'potential scope
                        If Rng.Offset(0, 10).Value = ComboBox7.Value Then
                        Else
                        Rng.Offset(0, 10).Value = ComboBox7.Value
                        End If
                        'ly potential scope
                        If Rng.Offset(0, 11).Value = ComboBox8.Value Then
                        Else
                        Rng.Offset(0, 11).Value = ComboBox8.Value
                        End If
                        'learning offer adp/mdp
                        If Rng.Offset(0, 12).Value = ComboBox9.Value Then
                        Else
                        Rng.Offset(0, 12).Value = ComboBox9.Value
                        End If
                        'learing offer %
                        If Rng.Offset(0, 13).Value = TextBox22.Value Then
                        Else
                        Rng.Offset(0, 13).Value = TextBox22.Value
                        End If
                        'learning offer sign off date
                        If Rng.Offset(0, 14).Value = TextBox21.Value Then
                        Else
                        Rng.Offset(0, 14).Value = TextBox21.Value
                        End If
                        'mother tongue
                        If Rng.Offset(0, 15).Value = ComboBox10.Value Then
                        Else
                        Rng.Offset(0, 15).Value = ComboBox10.Value
                        End If
                        'additional lang 1
                        If Rng.Offset(0, 16).Value = ComboBox11.Value Then
                        Else
                        Rng.Offset(0, 16).Value = ComboBox11.Value
                        End If
                        'additional lang 2
                        If Rng.Offset(0, 17).Value = ComboBox12.Value Then
                        Else
                        Rng.Offset(0, 17).Value = ComboBox12.Value
                        End If
                        'additional lang 3
                        If Rng.Offset(0, 18).Value = ComboBox13.Value Then
                        Else
                        Rng.Offset(0, 18).Value = ComboBox13.Value
                        End If
                        'secondment
                        If Rng.Offset(0, 19).Value = ComboBox14.Value Then
                        Else
                        Rng.Offset(0, 19).Value = ComboBox14.Value
                        End If
                        'length of secodment
                        If Rng.Offset(0, 20).Value = ComboBox15.Value Then
                        Else
                        Rng.Offset(0, 20).Value = ComboBox15.Value
                        End If
                        'relocation 1
                        If Rng.Offset(0, 21).Value = ComboBox16.Value Then
                        Else
                        Rng.Offset(0, 21).Value = ComboBox16.Value
                        End If
                        'relocation 2
                        If Rng.Offset(0, 22).Value = ComboBox17.Value Then
                        Else
                        Rng.Offset(0, 22).Value = ComboBox17.Value
                        End If
                        'learning offer courses
                        If Rng.Offset(0, 23).Value = ComboBox18.Value Then
                        Else
                        Rng.Offset(0, 23).Value = ComboBox18.Value
                        End If
                        'rdf courses
'inform user
            'MsgBox "Comment Saved",64, "Record Saved"
        End If
   
ExitSub:
'turn events on
With Application
    .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic
End With

If Err > 0 Then
'report errors
    MsgBox (Error(Err)), 48, "Error"
Else
'close form
    If Not Rng Is Nothing Then
    MsgBox ("Updates Saved")
        
    Else
'inform user
        MsgBox "Nothing found", 64, "Not Found"
    End If
End If
End Sub
 
Upvote 0
I'm not sure what else to suggest, the only thing I can think of is writing the values to an array, and then pasting them back, but I have never dealt with this and although I get the idea behind it, I don't think I can figure out how to relate it to your code.

Hopefully an MVP or someone more competent will be able to chime in and suggest some changes.

I will continue to ponder the case but currently I don't see how I can assist in developing it further.


When you fill the userform2, you could always tidy it up with a;


With userform2
.combo
.text
.etc
End With


There has to be a way to tidy the number of If statements also, but can't see a way around it currently.

Sorry, I can't help you further, but as I say, I will keep an eye on the thread.

Coops
 
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,826
Messages
6,181,192
Members
453,021
Latest member
pingpong7117

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