VBA to retrieve data

K

K_Stevs1

New Member
Joined
Jan 27, 2022
Messages
20
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hi,

Is there vba to retrieve data from a specific row in Sheet2 (Based on cell f5) and back into the correct Cells in Sheet1 to allow a form to be completed by another person or updated, then resubmitted and overwrite the data that was there originally?

Thanks
 
Sort by date Sort by votes
Hi Thank you for your help with this,

I have tried the code but keep getting this error every time.

1722419163940.png


Or when running the code in VB I automatically get this window?

1722419104813.png


Thanks
dreid1011 said:
Alright, see if this does what you want. There are three subs here.

The first will pull the record info from 'Data' when an ID is entered into F5 (E5 because it's a merged cell). If the ID cannot be found on 'Data' then it will prompt the user asking if it is a new ID or not. If not, then it clears the form. If it is a new ID, then it does not clear the form, and allows for data entry.

The second will add/update record info from 'Form' to 'Data' when the form is submitted. *If you are using an ActiveX Form Control button, then you must rename the button to match the sub name, or rename the sub name to match the button name. (It looks like you are using this type of button.)

The third is the clear form code but in it's own sub to keep the clutter down since it is used a couple times.

In each sub, I commented out the lines for fields 52 to 69 because your sample data did not include them, but your code does. So if you need them, just uncomment them. Also, your code currently does not include the two fields I highlighted in red above, so I still do not know where that data is supposed to come from.

Also, I imagine the errors you are encountering, are partly due to your cells being merged and you are not referencing the correct cells. And you are directly referencing sheet names as if they were variables.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newID
Dim idRow As Long, i As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Sheets("Form")
Set ws2 = Sheets("Data")

Application.EnableEvents = False
Application.ScreenUpdating = False

On Error GoTo ExitNow

If Not Intersect(Target, Range("E5:H5")) Is Nothing Then
    ws1.Unprotect
    ws2.Unprotect
    idRow = 0
    For i = 2 To ws2.Range("B" & Rows.Count).End(xlUp).Row
        If ws2.Range("B" & i) = Target Then
            idRow = i
            Exit For
        End If
    Next i
    If idRow > 0 Then
        ws1.Range("E4") = ws2.Range("A" & idRow) 'Date
        ws1.Range("E6") = ws2.Range("C" & idRow) '3
        'ws1.Range("H6") = ?? 'What about H6?
        ws1.Range("E7") = ws2.Range("D" & idRow) '4
        ws1.Range("E8") = ws2.Range("E" & idRow) '5
        ws1.Range("K9") = ws2.Range("F" & idRow) '6
        ws1.Range("K10") = ws2.Range("G" & idRow) '7
        ws1.Range("K12") = ws2.Range("H" & idRow) '8
        ws1.Range("D14") = ws2.Range("J" & idRow) '10
        ws1.Range("K14") = ws2.Range("K" & idRow) '11
        ws1.Range("D15") = ws2.Range("L" & idRow) '12
        ws1.Range("K15") = ws2.Range("M" & idRow) '13
        'Section b
        ws1.Range("D18") = ws2.Range("N" & idRow) '14
        ws1.Range("K18") = ws2.Range("O" & idRow) '15
        ws1.Range("D19") = ws2.Range("P" & idRow) '16
        ws1.Range("K19") = ws2.Range("Q" & idRow) '17
        ws1.Range("E21") = ws2.Range("R" & idRow) '18
        ws1.Range("K22") = ws2.Range("S" & idRow) '19
        ws1.Range("K23") = ws2.Range("T" & idRow) '20
        ws1.Range("E24") = ws2.Range("U" & idRow) '21
        ws1.Range("E25") = ws2.Range("V" & idRow) '22
        ws1.Range("E28") = ws2.Range("W" & idRow) '23
        ws1.Range("K30") = ws2.Range("X" & idRow) '24
        ws1.Range("E31") = ws2.Range("Y" & idRow) '25
        ws1.Range("K33") = ws2.Range("Z" & idRow) '26
        ws1.Range("E34") = ws2.Range("AA" & idRow) '27
        ws1.Range("E36") = ws2.Range("AB" & idRow) '28
        ws1.Range("K37") = ws2.Range("AC" & idRow) '29
        ws1.Range("K39") = ws2.Range("AD" & idRow) '30
        ws1.Range("E42") = ws2.Range("AE" & idRow) '31
        ws1.Range("E43") = ws2.Range("AF" & idRow) '32
        ws1.Range("E44") = ws2.Range("AG" & idRow) '33
        ws1.Range("E45") = ws2.Range("AH" & idRow) '34
        'Section c
        ws1.Range("C48") = ws2.Range("AI" & idRow) '35
        ws1.Range("H48") = ws2.Range("AJ" & idRow) '36
        ws1.Range("M48") = ws2.Range("AK" & idRow) '37
        ws1.Range("K51") = ws2.Range("AL" & idRow) '38
        ws1.Range("K52") = ws2.Range("AM" & idRow) '39
        ws1.Range("K53") = ws2.Range("AN" & idRow) '40
        ws1.Range("K56") = ws2.Range("AO" & idRow) '41
        ws1.Range("K57") = ws2.Range("AP" & idRow) '42
        ws1.Range("K58") = ws2.Range("AQ" & idRow) '43
        ws1.Range("K59") = ws2.Range("AR" & idRow) '44
        ws1.Range("K60") = ws2.Range("AS" & idRow) '45
        ws1.Range("E63") = ws2.Range("AT" & idRow) '46
        ws1.Range("K64") = ws2.Range("AU" & idRow) '47
        ws1.Range("E65") = ws2.Range("AV" & idRow) '48
        'ws1.Range("I65") = ?? 'What about I65?
        ws1.Range("E66") = ws2.Range("AW" & idRow) '49
        ws1.Range("K69") = ws2.Range("AX" & idRow) '50
        ws1.Range("K71") = ws2.Range("AY" & idRow) '51
       
        'Sample data did not include these fields
'        ws1.Range("K73") = ws2.Range("AZ" & idRow) '52
'        ws1.Range("K82") = ws2.Range("BA" & idRow) '53
'        ws1.Range("K84") = ws2.Range("BB" & idRow) '54
'        ws1.Range("K85") = ws2.Range("BC" & idRow) '55
'        ws1.Range("K86") = ws2.Range("BD" & idRow) '56
'        ws1.Range("K88") = ws2.Range("BE" & idRow) '57
'        ws1.Range("K89") = ws2.Range("BF" & idRow) '58
'        ws1.Range("K92") = ws2.Range("BG" & idRow) '59
'        ws1.Range("K93") = ws2.Range("BH" & idRow) '60
'        ws1.Range("K96") = ws2.Range("BI" & idRow) '61
'        ws1.Range("K98") = ws2.Range("BJ" & idRow) '62
'        ws1.Range("K109") = ws2.Range("BK" & idRow) '63
'        ws1.Range("K111") = ws2.Range("BL" & idRow) '64
'        ws1.Range("K112") = ws2.Range("BM" & idRow) '65
'        ws1.Range("K114") = ws2.Range("BN" & idRow) '66
'        ws1.Range("K116") = ws2.Range("BO" & idRow) '67
'        ws1.Range("K117") = ws2.Range("BP" & idRow) '68
'        ws1.Range("K118") = ws2.Range("BQ" & idRow) '69

       
    Else
        'Clear form if ID not found on Data sheet and not entering a new record
        newID = MsgBox("ID not found. Enter new record?", vbYesNo, "Unknown ID")
        If newID = vbNo Then
            Call FormClear
            GoTo ExitNow
        End If
    End If
End If

ExitNow:
ws1.Protect
ws2.Protect
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

VBA Code: 
Private Sub SubmitButton_Click()
Dim idRow As Long, i As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Sheets("Form")
Set ws2 = Sheets("Data")

ws1.Unprotect
ws2.Unprotect

idRow = 0

For i = 2 To ws2.Range("B" & Rows.Count).End(xlUp).Row
    If ws2.Range("B" & i) = ws1.Range("E5") Then
        idRow = i
        Exit For
    End If
Next i

If idRow = 0 Then
    idRow = ws2.Range("B" & Rows.Count).End(xlUp).Row + 1
End If

If ws1.Range("E5") <> "" And ws1.Range("E6") <> "" Then
    ws2.Range("A" & idRow) = ws1.Range("E4") 'Date
    ws2.Range("B" & idRow) = ws1.Range("E5") 'ID
    ws2.Range("C" & idRow) = ws1.Range("E6") '3
    'What about H6? ws1.Range("H6") = ??
    ws2.Range("D" & idRow) = ws1.Range("E7") '4
    ws2.Range("E" & idRow) = ws1.Range("E8") '5
    ws2.Range("F" & idRow) = ws1.Range("K9") '6
    ws2.Range("G" & idRow) = ws1.Range("K10") '7
    ws2.Range("H" & idRow) = ws1.Range("K12") '8
    ws2.Range("J" & idRow) = ws1.Range("D14") '10
    ws2.Range("K" & idRow) = ws1.Range("K14") '11
    ws2.Range("L" & idRow) = ws1.Range("D15") '12
    ws2.Range("M" & idRow) = ws1.Range("K15") '13
    'Section b
    ws2.Range("N" & idRow) = ws1.Range("D18") '14
    ws2.Range("O" & idRow) = ws1.Range("K18") '15
    ws2.Range("P" & idRow) = ws1.Range("D19") '16
    ws2.Range("Q" & idRow) = ws1.Range("K19") '17
    ws2.Range("R" & idRow) = ws1.Range("E21") '18
    ws2.Range("S" & idRow) = ws1.Range("K22") '19
    ws2.Range("T" & idRow) = ws1.Range("K23") '20
    ws2.Range("U" & idRow) = ws1.Range("E24") '21
    ws2.Range("V" & idRow) = ws1.Range("E25") '22
    ws2.Range("W" & idRow) = ws1.Range("E28") '23
    ws2.Range("X" & idRow) = ws1.Range("K30") '24
    ws2.Range("Y" & idRow) = ws1.Range("E31") '25
    ws2.Range("Z" & idRow) = ws1.Range("K33") '26
    ws2.Range("AA" & idRow) = ws1.Range("E34") '27
    ws2.Range("AB" & idRow) = ws1.Range("E36") '28
    ws2.Range("AC" & idRow) = ws1.Range("K37") '29
    ws2.Range("AD" & idRow) = ws1.Range("K39") '30
    ws2.Range("AE" & idRow) = ws1.Range("E42") '31
    ws2.Range("AF" & idRow) = ws1.Range("E43") '32
    ws2.Range("AG" & idRow) = ws1.Range("E44") '33
    ws2.Range("AH" & idRow) = ws1.Range("E45") '34
    'Section c
    ws2.Range("AI" & idRow) = ws1.Range("C48") '35
    ws2.Range("AJ" & idRow) = ws1.Range("H48") '36
    ws2.Range("AK" & idRow) = ws1.Range("M48") '37
    ws2.Range("AL" & idRow) = ws1.Range("K51") '38
    ws2.Range("AM" & idRow) = ws1.Range("K52") '39
    ws2.Range("AN" & idRow) = ws1.Range("K53") '40
    ws2.Range("AO" & idRow) = ws1.Range("K56") '41
    ws2.Range("AP" & idRow) = ws1.Range("K57") '42
    ws2.Range("AQ" & idRow) = ws1.Range("K58") '43
    ws2.Range("AR" & idRow) = ws1.Range("K59") '44
    ws2.Range("AS" & idRow) = ws1.Range("K60") '45
    ws2.Range("AT" & idRow) = ws1.Range("E63") '46
    ws2.Range("AU" & idRow) = ws1.Range("K64") '47
    ws2.Range("AV" & idRow) = ws1.Range("E65") '48
    'What about I65? ws1.Range("I65") = ??
    ws2.Range("AW" & idRow) = ws1.Range("E66") '49
    ws2.Range("AX" & idRow) = ws1.Range("K69") '50
    ws2.Range("AY" & idRow) = ws1.Range("K71") '51
   
    'Sample data did not include these fields
'    ws2.Range("AZ" & idRow) = ws1.Range("K73") '52
'    ws2.Range("BA" & idRow) = ws1.Range("K82") '53
'    ws2.Range("BB" & idRow) = ws1.Range("K84") '54
'    ws2.Range("BC" & idRow) = ws1.Range("K85") '55
'    ws2.Range("BD" & idRow) = ws1.Range("K86") '56
'    ws2.Range("BE" & idRow) = ws1.Range("K88") '57
'    ws2.Range("BF" & idRow) = ws1.Range("K89") '58
'    ws2.Range("BG" & idRow) = ws1.Range("K92") '59
'    ws2.Range("BH" & idRow) = ws1.Range("K93") '60
'    ws2.Range("BI" & idRow) = ws1.Range("K96") '61
'    ws2.Range("BJ" & idRow) = ws1.Range("K98") '62
'    ws2.Range("BK" & idRow) = ws1.Range("K109") '63
'    ws2.Range("BL" & idRow) = ws1.Range("K111") '64
'    ws2.Range("BM" & idRow) = ws1.Range("K112") '65
'    ws2.Range("BN" & idRow) = ws1.Range("K114") '66
'    ws2.Range("BO" & idRow) = ws1.Range("K116") '67
'    ws2.Range("BP" & idRow) = ws1.Range("K117") '68
'    ws2.Range("BQ" & idRow) = ws1.Range("K118") '69
   
   
    Call FormClear
    ws2.Activate
    MsgBox "Your data has successfully been submitted!", vbOKOnly, "Success!"
Else
    MsgBox "Please ensure that the Date of MDT Review & the local identifier has been completed before trying to submit the data.", vbOKOnly + vbCritical, "Error: Required Fields Missing"
End If

ws1.Protect
ws2.Protect

End Sub

VBA Code: 
Private Sub FormClear()
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Sheets("Form")
Set ws2 = Sheets("Data")

ws1.Range("E4").ClearContents 'Date
ws1.Range("E5").ClearContents 'ID
ws1.Range("E6").ClearContents '3
'ws1.Range("H6") = ?? 'What about H6?
ws1.Range("E7").ClearContents '4
ws1.Range("E8").ClearContents '5
ws1.Range("K9").ClearContents '6
ws1.Range("K10").ClearContents '7
ws1.Range("K12").ClearContents '8
ws1.Range("D14").ClearContents '10
ws1.Range("K14").ClearContents '11
ws1.Range("D15").ClearContents '12
ws1.Range("K15").ClearContents '13
'Section b
ws1.Range("D18").ClearContents '14
ws1.Range("K18").ClearContents '15
ws1.Range("D19").ClearContents '16
ws1.Range("K19").ClearContents '17
ws1.Range("E21").ClearContents '18
ws1.Range("K22").ClearContents '19
ws1.Range("K23").ClearContents '20
ws1.Range("E24").ClearContents '21
ws1.Range("E25").ClearContents '22
ws1.Range("E28").ClearContents '23
ws1.Range("K30").ClearContents '24
ws1.Range("E31").ClearContents '25
ws1.Range("K33").ClearContents '26
ws1.Range("E34").ClearContents '27
ws1.Range("E36").ClearContents '28
ws1.Range("K37").ClearContents '29
ws1.Range("K39").ClearContents '30
ws1.Range("E42").ClearContents '31
ws1.Range("E43").ClearContents '32
ws1.Range("E44").ClearContents '33
ws1.Range("E45").ClearContents '34
'Section c
ws1.Range("C48").ClearContents '35
ws1.Range("H48").ClearContents '36
ws1.Range("M48").ClearContents '37
ws1.Range("K51").ClearContents '38
ws1.Range("K52").ClearContents '39
ws1.Range("K53").ClearContents '40
ws1.Range("K56").ClearContents '41
ws1.Range("K57").ClearContents '42
ws1.Range("K58").ClearContents '43
ws1.Range("K59").ClearContents '44
ws1.Range("K60").ClearContents '45
ws1.Range("E63").ClearContents '46
ws1.Range("K64").ClearContents '47
ws1.Range("E65").ClearContents '48
'ws1.Range("I65") = ?? 'What about I65?
ws1.Range("E66").ClearContents '49
ws1.Range("K69").ClearContents '50
ws1.Range("K71").ClearContents '51

'Sample data did not include these fields
'ws1.Range("K73").ClearContents  '52
'ws1.Range("K82").ClearContents  '53
'ws1.Range("K84").ClearContents  '54
'ws1.Range("K85").ClearContents  '55
'ws1.Range("K86").ClearContents  '56
'ws1.Range("K88").ClearContents  '57
'ws1.Range("K89").ClearContents  '58
'ws1.Range("K92").ClearContents  '59
'ws1.Range("K93").ClearContents  '60
'ws1.Range("K96").ClearContents  '61
'ws1.Range("K98").ClearContents  '62
'ws1.Range("K109").ClearContents  '63
'ws1.Range("K111").ClearContents  '64
'ws1.Range("K112").ClearContents  '65
'ws1.Range("K114").ClearContents  '66
'ws1.Range("K116").ClearContents  '67
'ws1.Range("K117").ClearContents  '68
'ws1.Range("K118").ClearContents  '69

End Sub
Click to expand...
 
Upvote 0

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
K_Stevs1 said:
Hi Thank you for your help with this,

I have tried the code but keep getting this error every time.

View attachment 114753

Or when running the code in VB I automatically get this window?

View attachment 114752

Thanks
Click to expand...
I'm not sure why you are getting the first error. The second issue is because you are trying to run a "Worksheet_Change" event from the editor. It doesn't really work that way. Event code only runs when you trigger the event from the worksheet. Now I am trying to resolve another issue, I will let you know what I figure out.
 
Upvote 0
Does the first error highlight any lines in the code?
 
Upvote 0
dreid1011 said:
Does the first error highlight any lines in the code?
Click to expand...
Hi

1st error - no, no lines are being highlighted, if I unmerge the Cell will it be easier to use just E5?
2nd error - resolved

Thank you
 
Upvote 0
K_Stevs1 said:
Hi

1st error - no, no lines are being highlighted, if I unmerge the Cell will it be easier to use just E5?
2nd error - resolved

Thank you
Click to expand...
No, I don't think that should matter, as the code is working just fine with merged cells on my end. There is likely something else going on.

Did you copy and paste all three pieces of code exactly as I posted them?

Do you have any other code besides what I gave you?

Did you put the code in the Sheet module or a standard module?
1722866599006.png
 
Upvote 0
Yes, I copied them and added them in to the Module 1 section.

Thanks

dreid1011 said:
No, I don't think that should matter, as the code is working just fine with merged cells on my end. There is likely something else going on.

Did you copy and paste all three pieces of code exactly as I posted them?

Do you have any other code besides what I gave you?

Did you put the code in the Sheet module or a standard module?
View attachment 114963
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question
I am new to VBA and I am trying to figure out how I can use VBA to fill out an online risk calculator using data from excel
Replies
2
Views
144
John_w
J
L
  • Question
Draw data from website
Replies
2
Views
305
Lux Aeterna
L
P
  • Solved
Loading sheet row data to a userform issue.
Replies
7
Views
127
DanteAmor
DanteAmor
Y
  • Question
VBA to copy, format, drag down data from other workbooks
Replies
1
Views
396
Yna26
Y
M
  • Solved
VBA retrieve object data
Replies
2
Views
351
mwl707
M

Forum statistics

Threads
1,221,528
Messages
6,160,343
Members
451,638
Latest member
MyFlower

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